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File ga_omega.vbp 

Type=Exe 

Fo rrn= f r m_ma in . f rm 

Reference=*\G{0002043 0-0000-0000-COOO- 

000000000046} #2 . 0#0# . . \WIND0WS\SYSTEM\Std01e2 . tlb#OLE Automation 

Mo du 1 e =nmga ; nrn ga 1 . ba s 

Class=token_group; token_group .els 

Form=f rm_tokens . f rm 

Form=f rm_new_group . frm 

Form=f rrn_edit_token. frm 

Form=f rm_options . frm 

Object={B02F3647-766B-llCE-AF28-C3A2FBE76A13}#2.5#0; SS32X25.0CX 
Object={02B5E320-7292-llCF-93D5-0020AF99504A}#1.0#0; MSCHART.OCX 
Object={BDC217C8-ED16-llCD-956C-0000C04E4C0A}#l.l#0; TABCTL32 .OCX 
Object={6B7E6392-850A-101B-AFC0-42101O2A8DA7}#1.2#0; COMCTL32 .OCX 
Form=frm_text . frm 

Reference=*\G{0D452EEl-E08F-101A-852E- 

02608C4D0BB4}#2.0#0#. .\WINDOWS\SYSTEM\FM20 .DLL#Microsof t Forms 2.0 
Object Library 
Form=f rm_graphics . frm 

Object={827E9F53-96A4-llCF-823E-000021570103}#1.0#0; GRAPHS32 .OCX 
Form-f rm_histo . fm 
Form=f rm_sort_results . frm 
Form=f rm_debug . frm 

Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB} #1 . 1#0 ; Comdlg32 . ocx 

Object={D5EEA3C0-6216-llCF-BE62-0080C72EDD2D}#1.0#0; MARQUEE . OCX 

IconForm=" frm_main" 

Startiip="Sub Main" 

EelpFile=" " 

ExeNaine3 2 = " NM_GA . exe " 

Command32= , " , 

Name-" nm__ga" 

HelpContextID= "0" 

CompatibleMode^ " 0 " 

MajorVer=l 

MinorVer=0 

RevisionVer=0 

Au t olncremen t Ve r = 0 

Serve rSupportFiles=0 

VersionCompanyName= " MG A Software" 

CompilationType-0 

OptimizationType=0 

Favor Pent iumPro (tm) =0 

CodeViewDebugInfo=0 

NoAliasing=0 

BoundsCheck=0 

Overf lowCheck=0 

FlPointCheck=0 

FDIVCheck=0 

UnroundedFP=0 

StartMode=0 

Unattended=0 

ThreadPerObject=0 
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MaxNumberOfThreads=l 
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File ga_omega_vbw 

frm_main = 7, 101, 900, 674, , 8, 12, 949, 661, 
rung a = -2, 23, 950, 688, 
token_group =35, 60, 863, 536, 

frm_tokens = 224, 49, 903, 525, C, 55, 125, 945, 601, C 
frm_new_group = 176, 176, 710, 652, C, 154, 154, 688, 630, C 
frm_edit_token = 132, 132, 683, 608, C, 154, 154, 705, 630, 
frm_options = 183, 165, 734, 641, C, 25, 20, 649, 606, 
frm_text = 132, 132, 761, 608, Z, 91, 10, 836, 651, C 
frm_graphics = 42, 12, 746, 651, C, 36, 11, 824, 689, C 
frm_histo = 0, 0, 757, 476, C, 32, -9, 901, 688, C 
frm_sort__results = 22, 22, 722, 591, C, 0, 0, 733, 476, C 
frm_debug = 132, 132, 633, 600, C, 110, 110, 678, 578, C 
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File nm._gal.bas 

Attribute VB_Name = "nmga" 
Option Explicit 

Private Declare Function nmv_exeLib "c:\nmvexe\vc\nmv_exe.dH" _ 

(ByRef theta As Single, ByRef lltheta As Single, ultheta As Single, _ 
ByRef omega As Single, ByRef sigma As Single, ByRef obj As Single, _ 
ByRef success As Single, ByRef setheta As Single, _ 
ByRef seomega As Single, ByRef sesigma As Single, _ 
ByRef rm As Single) As Long 

Declare Sub Sleep Lib M kernel32" (ByVal dwMilliseconds As Long) 

Public paused As Boolean 

Public n_omega As Integer 

Public non_omega_bits As Integer, omega_bits As Integer 

Public n_non_omega_genes As Integer, omega_genes As Integer, n_genes As Integer 

Public unique_fit() As Double ' use to list fitness by genome in order to check to see if model has already 

been run 

Public n_unique As Integer 

Public current_model As Integer 

Public n_models As Integer 

Public Const n_groups As Integer = 50 

Public tokerj_collection(l To n_groups) As New token_group 

Public n_token_groups As Integer 

Public mutation_rate As Single 

Public last_gen As Integer 

Public cross_over_freq As Single 

Public frame_shift_prob As Single 

Public n_runs As Integer 

Public theta_crit As Single 

Public omega_crit As Single 

Public sigma_crit As Single 

Public cov_crit As Single 

Public corr_crit As Single 

Public pop_size As Integer 

Public generation_limit As Integer 

Public call_method As String 

Public genome() As Boolean ' catenation of structural genome and omega genome 

Public home_directory As String 

Public home_drive As String 

Public gen_directory As String 

Public run_number As Integer 

Public upperjitnessjimit As Single 

Public iower_fitness_limit As Single 

Public stop_run As Boolean 

Public this_gen As Integer 

Public thisjrun As Integer 

Public success_crit As Single 

Public save_control As Boolean 

Public save_output As Boolean 

Public start_files(l To 4) As String 

Public n_files As Integer 

Public omega_block As Boolean 

Public n_omega__block As Integer ' number of bits of the genome devoted to the omega block description 
Public n_omcga_sequcnce As Integer 'number of bits of the genome devoted to the omega sequence 
Const max_theta = 52 
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Public seed_type As String 
Public seed_value As Integer 
Public save_best As Boolean 



Sub MainQ 

Dim this_file As Integer 

n_files = GetSettmg(appname:= , 'NM_GA , \ section:="Startup ,, 1 _ 

Key:="N", Default:=0) 
For this_file = 1 To n_files 

start_files(this_file) = GetSetting(appname:="NM_GA M , section:=" Startup", 

Key:="File" & str(this_file) t Defaults" ") 
frm_main.files(this_file).Visible = True 
frm_main.files(this_file). Caption = start_files(thts_file) 
Next this_file 
home_directory = "cA" 

frm_main.Show 
End Sub 

Sub set_options() 
With frm_options 
.txt_mutation_rate = mutation_rate 
.txt_cross_over__freq = cross_over_freq 
.txt_frame_shift_prob = frame_shifr_prob 
.txt_theta_crit = theta_crit 
.txt_omega_crit = omega_crit 
.txt__sigma_crit = sigma_crit 
.txt_cov_crit = cov_crit 
,txt_generations = generation_limit 
.txt_upper_limit = upper_fitness_limit 
.txt_lower_limit = lower_fitness_limit 
.txt_corr_crit = corr_crit 
.txt_succ_crit = success_crit 
If omega_block = False Then 
.chk_non_diag_omega - 0 
Else 

.chk_non_diag_omega = 1 
End If 

If save_controI = False Then 
.chk_save„controI = 0 
Else 

.chk_save_control = 1 
End If 

If save_best = False Then 
.chk_save_best = 0 
Else 

.chk_save_best = 1 
End If 

If save_output = False Then 
.chk_save_output = 0 
Else 

xhk_save__output = 1 
End If 

Select Case seed_type 
Case "clock" 
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.opt_rnd_clock = True 
.txt_rnd_seed.Enabled = False 
Case "user" 
.opt_rnd_user = True 
.txt_rnd_seed = seed_value 
.txt_rnd_seed. Enabled = True 
Case "default" 
.opt_rnd_default = True 
.txt_rnd_seed. Enabled = False 
End Select 

If call_method = W Then .opt.dll = True 

If call_method = ,r exe" Then .opt„exe = True 

,txt_pop_size = pop_size 

If n_runs - 1 Then ,opt_lrun = True 

If n_runs = 2 Then .opt_2runs = True 

If n_runs = 4 Then .opt_4runs = True 

End With 

End Sub 



Sub get_bin(ByVa! in_num As Integer, ByRef bin_str() As Boolean) 
Dim n„genes As Integer, remainder As Integer, i As Integer, base As Integer 
n_genes = UBound(bin_str) 
base = 2 

For i = 1 To n_genes 
remainder = in_num Mod base 
If remainder > 0 Then 
bin_str(n_genes - i + 1) = True 
Else 

bin_str(n_genes - i + 1) = False 
End If 

in_num = in_num - remainder 

base = base * 2 

Nexti 

End Sub 



Sub grid„search() 
this_gen = 1 
this_run = 0 

Dim n_pop As Double, this_group As Integer, this_set As Integer 
Dim binary() As Boolean, valuesO As Integer, max_values() As Integer 
Dim n_genes As Integer, this_gene As Integer, this_ind As Integer 
Dim cur_gene As Integer 

n_genes = count_pmega_genes() + count_non_omega__genes() 
n_pop = get_n_pop() 
If n_pop < 1000000 Then 
Dim n„str As String 

If MsgBoxfThere will be " & n_pop & " runs" & vbCrLf &_ 

"Do you want to continue?' 1 , vbOKCancel, "Full grid search") o vbOK Then 
Exit Sub 
End If 
Else 

If n_pop > 1000000000 Then 
n_str = Format(n_pop, "Scientific") 
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Else 

n_srr = Format(n_pop, " 0,000,000,000") 
End If 

MsgBox ("There are " & n__str & " runs, cannot dimension genome this large, please use GA") 
Exit Sub 
End If 

' otherwise, continue 

ReDim values(l To n_genes, 1 To n_pop) 
ReDim binary( 1 To n_genes) 
ReDim max_values(l To n_genes) 
ReDim fitness(l To n_pop) 

For this_gene = 1 To n_genes 

max_values(this_gene) = token_collection(this_gene).n_token_sets 
Next this_gene 

' first set up the first indiivdual, all 1 's 
For this_gene = 1 To n_genes 

values(this_gene, 1) = 1 
Next this_gene 

* next creat the population 

'then increment each succesive individual, if you exceed max_values, increment the next 
For this_ind = 2 To n_pop 

For this_gene = 1 To n_genes 
values(this_gene, this_ind) = values(this_gene, this_ind - 1) 

Next this_gene 

values(n_genes, this_jnd) = values(n_genes, this_ind) + 1 
' check to see if this is over max 
cur_gene = n_genes 

While values(cur_gene, this_ind) > max_values(cur_gene) 
values(cur_gene, this_ind) = 1 

values(cur_gene - 1, this_ind) = values(cur_gene - 1, this_ind) + 1 
cur_gene = cur„gene - 1 
Wend 
Next this_ind 

gen__directory = home_directory & 1, \1 " 
Dim test As String 

test = Dir(gen_directory, vbDirectory) 
If test <> "1" Then 
MkDir (gen_directory) 
End If 

ChDir (home_directory & "U") 

* scaled fitness is dummy 
Dim scaled_fitness() As Single 
ReDim scaled_fitness(l To n_pop) 

* and run population 

run_population scaled Jfitness(), values(), False 
End Sub 

Sub ga_runner(start_new_run As Boolean, check_out As Boolean) 
Dim scaledJRtness() As Single 

Dim n_pop As Double, this_group As Integer, this_set As Integer 
Dim genes() As Integer, max_values() As Integer 
Dim unmapped_values() As Integer, total_bits As Long 
Dim n_bits() As Integer ' number of bits in each gene 
Dim totaLbit As Integer, this_bit As Integer 

Dim n_omega_genes As Integer, this_gene As Integer, this_ind As Integer 
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Dim cur_gene As Integer 

Dim n_rows As Integer, max_x As Single 

* set random seed if needed 

If seed_type - "clock" Then Randomize 

If seedjype = "user" Then Randomize (seed_value) 

* need to add genes for non-diagonai omega 
n_non_omega_genes = count_non_omega_genes() 
n_omega_genes - count_omega_genes() 
n_genes = n_non__omega_genes + n_omega_genes 

' n_pop is either the maximum number or the number selected 

' we need to distiguish between genes (on genes) and bits (on genome). 

' a gene is represented by one or more bits 

* n_pop is the population size, first well see ho 
n_pop - get_n_pop() 

If n_pop > pop_size Then 

n_pop = pop_size 
Else 

MsgBox ("Only " & n_pop & " combinations exist, will do grid search") 
gnd„search 
Exit Sub 
End If 

' unmapped values are the "raw" values straight from the genome 
' which is basically randomly generated 

' you unmap them to get the "genes", which is used to create the control file. 
ReDim unmapped_values(l To n_genes, 1 To n_pop) 
ReDim genes(l To n_genes, 1 To n„pop) 

ReDim n_bits(l To n_genes) * how many bits in each gene , only 1 if there are 2 possibilities, 2 if 3 or 4 etc 
ReDim fitness(l To n_pop) 
ReDim scaled_fitness(l To n_pop) 
ReDim max_values(l To n_genes) 
ReDim fitness(l To n_pop) 

ReDim unique_fit(l To n_pop * generationjimit, 1 To 7) 
! genome_integer, fitness,generation,indivdual, obj, success, covar, 
' need success and covar to put into the table. Scaled fitness will be added later, 
' from a new calculation. 

' find the maximum values that the gene can have, min value =1? 
non_omega_bits - count_non_omega_bits 
omega_bits = count_omega_bits 
total_bits = non_omega_bits + omega_bits 

For this_gene = 1 To n_non_omega_genes ' do not include omega genes 

max_values(this_gene) = token_collection(this_gene).n„token„sets 

n_bits(this_gene) = get_nbits(max_values(this_gene)) 
Next this_gene 

* next genes are block genes for omega, each is only 1 bit 

For this_gene = n_non_omega_genes + 1 To n_non_omega_genes + n_omega - 1 

max_values(this_gene) = 2 

n_bits(this_gene) - 1 
Next this_gene 

' final genes are sequence genes for omega 

Dim this_omega As Integer: this_ornega = n_omega 

For this„gene = n_non_omega_genes + n_omega To n_genes * do not include omega genes 
max_vaiues(this_gene) = this_omega 
this_omega = this_omega - 1 

n_bits(this_gene) = get_nbits(max_values(this_gene)) 
Next this_gene 
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' now that we know how many bits, we can define the size of the genome (a binary) 
'if genomoe is not yet defined 
frm_main.pgb_gen.max = generationjimit 

frm_main.pgb_gen.min = 0 
If start_new_run = True Then 

ReDim genome(l To total J)its, 1 To n_pop) 

' next creat the population 

y then increment each succesive individual, if you exceed max_vaiues, increment the next 
For this Jnd = 1 To n_pop 
For this_bit = 1 To total_bits 

genome(this_bit, this Jnd) = (Rnd() > 0.5) 
Next this_bit 
Next this_ind 

frm_main.pgb_gen. value = 0 
Else 'continue old run, first check to see if old genome is the right size 
this_gcn = last_gen 

If UBound(genome, 1) o total J)its Or UBound(genome, 2) <> n_pop Then 
MsgBox "Error in genome, starting new GA run 11 
ReDim genome(l To total_bits, 1 To n_pop) 

* create the population anyway, cant use old genome 

* then increment each succesive individual, if you exceed max_values, increment the next 
For this_ind - 1 To n_pop 

For this.bit = 1 To total J)its 

genome(this_bit, thisjnd) = (Rnd() > 0.5) 
Next this_bit 
Next this_ind 

frm_main.pgb_gen. value = this_gen 
End If 

End If 

ReDim min_fitness(l To generationjimit) 
ReDim mean_fltness(I To generationjimit) 
ReDim max_fitness(l To generationjimit) 
n_rows = generationjimit 
max_x - gencration_limit 

If start_new_run - True Then initialize_plot n_rows 
While this_gen < generationjimit And stop_run = False 

this_gen = this_gen + 1 

frm_main.pgb_gen.value = this_gen 

Dim ok As String 

gen_directory = home_directory & "V & this_gen 
ok = Dir(gen_directory, vbDirectory) 
If Trim(ok) = Trim(str(this_gen)) Then 

ok= Dir(gen_directory & M \control", vbNormal) 

If ok <> Then Kill gen_directory & H \* * w 
Else 

MkDir gen_directory 
ChDir gen_directory 
End If 

* uncode genome, write to unmapped values 
uncode unmapped_values(), n_bits() 
' then unmap 

unmap genes(), max_values(), unmapped_vaiues(), n_bits() 

run_popu!ation scaledJFitness, genes, check_out 

last_gen = this_gen 
' Dim test_str As String, i As Integer 
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* test_str = "before: " 

' For i = 1 To UBound(genome, 1) 
' If genome(i, 1) = True Then 

* test_str = test_str & i 
' Else 

test_str - test_str & 0 
' End If 
' Next i 

get„next_gen scaled_fitness ' only need genome, then goes back to uncode and unmap 
' test_str = test_str & vbCrLf & M after: " 
' For i = 1 To UBound(genome, 1) 
' If genome(u 1) = True Then 
' test_str = test_stx & 1 

* Else 

test_str = test_str & 0 
> End If 
' Nexti 

' MsgBox test_str, , "after" 

save_model "temp" & this_run & ".mdl" 'save a temp copy after every new genome defined 
Wend 

* frm_main.Show 1, frm_main 
End Sub 

Private Sub get_next_gen(scaled_fitness) 

Dim n_genes As Integer, this_ind As Integer, i As Integer 

Dim cum_fitness() As Single ' cummulative fitness, sum = 1 

Dim pairs() As Integer 

Dim n_pop As Integer 

n_genes = UBound(genome, 1) 

n_pop = UBound(scaled_fItness) 

ReDim cum_fitness(l To n_pop) 

Dim new„genome() As Boolean 

*ReDim new_genome(l To n_genes, 1 To n__pop) 

ReDim pairs(l To 2, 1 To n_pop / 2) 

If save_best = True Then 

Dim saved_genome() As Boolean: ReDim saved_genome(l To n_genes) 
Dim max_fitness As Single, best_one As Integer 
max_fitness = -9999999 
For i = 1 To n_pop 
If scaled _fitness(i) > max_fitness Then 
max_fitness = scaled_fitness(i) 
best_one = i 
End If 
Next i 

For i = 1 To n_genes 

saved_genome(i) = genome(i, best_one) 
Nexti 
End If 

' calculate cumulative fitness, scaled to 1. 
cum_fltness(l) = scaled_fitness(l) 
For i = 2 To n_pop 

cum_fitness(i) = cum_fitness(i - 1) + scaled_fltness(i) 
Nexti 

* and divide all by the sum 
For i = 1 To n_pop 
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cum_fitness(i) = cum_fitness(i) / cum_fitness(n_pop) 
Nexti 

select_pairs pairs, cum_fitness 

* cross them over 
cross_over_genes pairs 
' and mutate 
mutate_genes 
fxame_shift_genes 

' and if we ire saving the best 
If save_best = True Then 

For i = 1 To n_genes 
genome(i, n_pop) = saved_genome(i) 

Nexti 
End If 
End Sub 

Private Sub frame_shift_genes() 
' select which genes to frame shift 

* for these randomly select two points, 
' in the first place 

Dim this_gene As Integer, this_ind As Integer 
Dim start As Integer, last As Integer 
Dim rand As Single 

For this_ind = 1 To UBound(genome, 2) 
rand = Rnd() 

If rand < frame_shift_prob Then 
start = Rnd{) * UBound(genome, 1) + 1 
last = RndO * UBound(genome, 1) + 1 
If last > start Then 

If last >= UBound(genome, 1) Then last = UBound(genome, 1) - I 
If start <= 1 Then start = 1 

For this_gene = start To last - 1 

genome(this_gene + 1, this_ind) = genome(this_gene, this_ind) 
Next this_gene 

genome(last, this_ind) = genome(start, this_ind) 
End If 

If start > last Then 

* last cant be 1 or you try to write to position 0 
If last <=1 Then last =2 

If start >= UBound(genome, 1) Then start = UBound(genome, 1) 
For this_gene = start To last Step -1 
genome(this_gene - 1, this_ind) = genome(this_gene, this_ind) 
Next this_gene 

genome(last, this_ind) = genome(start } this_ind) 
End If 

End If * rand < frame_shift if 
Next this_ind 
End Sub 

Private Sub cross_over_genes(pairs() As Integer) 

* create new genome 

* there are n_pop/2 pairs, each pair results in 2 individuals in the new__genome 
Dim new_genome() As Boolean 

Dim this_pair As Integer, n_pairs As Integer, length As Integer 
Dim this_gene As Integer * 
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' genome is (gene,sub) 

'pairs is (1 to 2,nsub/2) 

n_pairs = UBound (pairs, 2) 

length = UBound (genome, 1) 

ReDim new__genome(length, n_pairs * 2) 

Dim where As Integer, rand As Single 

For this_pair = 1 To n_pairs 

'new individuals are (this_pair-l)*2 +1 and this_pair *2 in new_genome 
If Rnd() < cross_over_freq Then 

where = Rnd() * length 

For this_gene = 1 To where 
5 write the left half of the gene, up to where 

new_genome(this_gene, (this_pair - 1) * 2 + 1) = genome(this_gene, pairs(l, this_pair)) 
new_genome(this_gene, this_pair * 2) = genome(this_gene, pairs(2, this_pair)) 
Next this_gene 

For this_gene = where + 1 To length 
new_genome(this_gene, (this„pair -1)*2 + 1) = genome(this_gene, pairs(2, this_pair)) 
new_genome(this_gene, this_pair * 2) = genome(this_gene, pairs(l, this_pair)) 

Next this_gene 
Else 

' no cross over 

For this_gene = 1 To length 
new_genome(this_gene, (this_pair -1)*2+1) = genome(this_gene, pairs(l, this_pair)) 
new_genome(this_gene, this_pair * 2) = genome(this_gene, pairs(2, this_pair)) 

Next this_gene 
End If 

Next this_pair 

1 then copy new_genome to genome 
For this_gene = 1 To length 
For this_pair = 1 To n_pairs * 2 

genome(this_gene, this_pair) = new_genome(this_gene, this_pair) 

Next this_pair 
Next this_gene 
End Sub 

Private Sub mutate_genes() 
Dim n_genes As Integer, this_gene As Integer 
Dim n_pop As Integer, this_ind As Integer 
Dim rand As Single 

n_genes = UBound(genome, 1): n_pop = UBound(genome 5 2) 
For this_gene = 1 To n_genes 

For this_ind = 1 To n_pop 

rand = Rnd() 

If rand < mutation_rate Then genome(this_gene, this_ind) = Not (genome(this_gene, this__ind)) 

Next this_ind 
Next this__gene 
End Sub 

Function get_nbits(number As Integer) As Integer 
If number = 0 Then 
get_nbits = 0 
Else 

get_nbits = Log(number) / Log(2) + 0.4999 
End If 

End Function 

Sub run_population(scaled_fitness() As Single, values() As Integer, check_out As Boolean) 
Dim limit„str As String * is theta at the upper or lower limit 
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Dim genome_integer As Double, old_fitness As Single 
Dim old_gen As Integer, old_ind As Integer, old_dir As String 
Dim already_run As Boolean 
Dim fitnessO As Single 

Dim n_ind As Integer, control_code As String, i As Integer, ok As String 

Dim n_genes As Integer, one„run_values() As Integer 

Dim obj As Single, success As Integer, covar As Integer 

n_ind = UBound( values, 2) 

ReDim fitness(n_ind) 

ReDim new_fitness(n„ind) 

n_genes = UBound( values, 1) 

ReDim one_run_values(l To n_genes) 

Dim this_runl As Integer 

this_run = 0 

frm_main.pgb_ind.max = n_ind 

**************** ***************************** ******************** 
i**************** TOP Qp POPULATION LOOP ************************ 
***************************************************************** 

For this_runl = 1 To n_ind ' this_runl = local this_run 
frm_main.pgb_md. value — this_runl 
frm_main.Refresh 
DoEvents 

Do While paused = True 

DoEvents 

Sleep 500 
Loop 

this_run = this_run + 1 
firm_main.spr_result.col - 9 

frm_main. spr_result.ro w = (this_gen - 1) * n_ind + this_runl 
frm_main.spr_result. value = this_runl 
frm_main.spr_result.col = 8 
frm_main.spr_result value = this_gen 
DoEvents 

If stop_run = True Then Exit Sub 
For i = 1 To n_genes 

one_run_values(i) = values(i, tbis_runl) 
Nexti 

control_code = make_control(frm_main.txt_code, one_run_values(), token_collection()) 
ok = Dir(gen_directory & "\" & this_runl, vbDirectory) 
If Trim(ok) = Trim(str(this_runl)) Then 

ok = Dir(gen_directory & "V 1 & this_runl & "\controi", vbDirectory) 

If oko Then Kill gen_directory & "\" & this_runl & "\* *" 
Else 

MkDir gen_directory & "\" & this_runl 
ChDir gen_directory & T & this_runl 
End If 

Open gen_directory & "V & this_runl & "\control" For Output As #1 
Print #1 , control_code 
Close #1 

' first check to see if this genome has been run 
already jrun = False 

limit_str = reset the string that describes whether theta is at the boundry to null 
genomejnteger = make_int(this_runl) 
For i = 1 To n_unique 
If genome_integer = unique_fit(i, 1) Then 
fitness(this_runl) = unique_fit(i, 2) 
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okLgen - unique_fit(i, 3) 
old_ind = unique_fit(i, 4) 
obj = unique_fit(i, 5) 
success = unique_fit(i, 6) 
covar = unique_fit(i, 7) 
run„number = runjnumber + 1 
already_run = True 

* need to recalcuate limit_str for already run model NOT DONE YET 
Exit For 
End If 

Next i 

Sleep 100 ' to clear file buffer before deleteing files. 
If already_run = False Then 

fitness(this_runl) = call_nm("c:", gen_directory & "\" & this_runl, "control", obj, success, covar, limit_str, 
check_out) 

On Error Resume Next * don't ned to worry if you cant delete file 

If Dir( M fdata*\ vbNormal) o "" Then Kill ("fdata") 

If Dir( M link.lnk", vbNormal) o Then Kill ("link.lnk") 

If Dir("prderr", vbNormal) o '"' Then Kill ("prderr") 

If Dir("freport'\ vbNormal) o Then Kill ("freport") 

If Dirffsubs", vbNormal) o Then Kill ("feubs") 

If Dir("fsubs.for", vbNormal) <> Then Kill ("fsubs.for") 

If DirC'nonmem.exe", vbNormal) o "" Then Kill (" nonmem.exe") 

IfDirCdf.txt", vbNormal) <> Then Kill ("df.txt") 

On Error GoTo 0 

n_unique = n_unique + 1 

frm_main.lbl_count = n_unique 

unique_fit(n_unique, 1) = genomejnteger: unique_fit(n_unique, 2) = fitness(this_runl) 
unique_fit(n_unique, 3) = this_gen: unique__fit(n_unique, 4) = this_runl 
unique_fit(n_unique, 5) = obj: unique Jflt(n_unique, 6) = success 
unique_fit(n_unique, 7) = covar 

* need to write the results to the spreadsheet, usually done by call_nm 
Else 

old_dir = home_directory & "V & Trim(str(old_gen)) & "\" & Trim(str(old_ind)) & "V 

ChDir (gen_directory & M V & this_runl) 

If LCase(Dir(old_dir & "control")) = "control" Then 

FiieCopy old_dir & "control", CurDir & "Xcontrol" 

End If 

If LCase(Dir(old_dir & "result")) = "result 1 ' Then 
FiieCopy old_dir & "result", CurDir & "\result" 
End If 

If LCase(Dir(old_dir & "output")) = "output" Then 
FiieCopy old_dir & "result", CurDir & "\output" 
End If 

If LCase(Dir(okLdir & "inputs")) = "inputs" Then 
FiieCopy old_dir & "inputs", CurDir & "\mputs" 
End If 

If LCase(Dir(old_dir & "parms")) = "parms" Then 
FiieCopy old_dir & "parms", CurDir & "\parms" 
End If 
End If 

' and write the results 
With frm_main.spr_result 
.col = 2 

If success = 0 Then 
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.text = "Yes" 
Else 

.text = "No" 
End If 

.row - run_number 

.col = 3 

If success = 0 And covar — 0 Then 

.text = "Yes" 

Else 

.text = "No" 
End If 
.col = 4 

.text = fitness(this_runl) 
.col = 1 

If obj < 999999999.9 Then 

.text = obj 

Else 

.text = "Crash" 
.col - 2 
.text = "No" 
.col = 3 
.text = ''No" 
.col = 4 
.text= "Crash" 
End If 
.col =11 
.text = limit_str 
.col = I 
.Action = 0 
End With 

DoE vents: frmjmain.Refresh 

If save_control = False Then Kill "control" 

If save_output = False Then 

If DirfAoutput", vbNormal) = "result" Then Kill "result" 
End If 

If stop_run = True Then Exit Sub 
Next this_runl 

scale_fltness scaled_fitness(), fitness() 
' update plot 

update_plot fitnessQ, scaled Jitness() 
End Sub 

Sub update_plot(fitness() As Single, scaled_fitness() As Single) 
* first append new fitness values onto alljitness 
' need to check to see if n generations is exceeded for time limited 
Dim i As Integer, n As Integer 

Dim this_min As Single, this__max As Single, this_mean As Single 

Dim sum As Single, count As Integer 

this_min = 999999999 

this_max = -99999999 

sum = 0 

count = 0 

For i = 1 To UBound(fitness) 

If fitness(i) < 9999999 Then 
If fitness(i) < this_min Then this__min = fitness(i) 
If fitness(i) > this_max Then this_max = fitness(i) 
sum = sum + fitness(i) 
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count = count + 1 
End If 
Next i 

If count o 0 Then 
this_mean = sum / count 
Else 

this_mean = 1000000 
End If 

With frm_main.MSChartl 
xow = this_gen 
.Column = 1 
.Data= this_min 
.Column = 2 
.Data - this_mean 
.Column = 3 
.Data = this_max 

.DrawMode = VtChDrawModeDraw 
End With 

With frm_main.spr_result 
.col = 10 

For i = 1 To pop_size 

.row = (this_gen - 1) * pop_size + i 

.text = Format(scaled_fitness(i), M 0.000 M ) 

Nexti 



End With 
End Sub 

Sub initialize_plot(n_rows As Integer) 

Dim i As Integer, n As Integer 

' final 2 columns define upper limit of axis 

With fxm_main.MSChartl 

.RowCount = 0 

.ColumnCount = 0 

.RowCount - n_rows 

.ColumnCount = 3 

For i = 1 To n_rows 

.row = i 

.RowLabel = i 
Nexti 

.DrawMode = VtChDrawModeDraw 
End With 
End Sub 

Function get_n_pop() As Double 

Dim this_group As Integer, n_sets As Double 

n_sets = 1 

For this_group = 1 To n_token_groups 

n_sets = n_sets * token_collection(this_group).n_token_sets 

Next this_group 

get_n_pop = n_sets 

End Function 

Function make_ - control(ga_code As String, valuesQ As Integer, _ 

token_collection() As token_group) As String 
' so, search ga_code for each instance of stem(L) to stem(n_token_groups) 

1 thetas will be "{THETA(a)}" in the $PK, ERROR or pred and M {$THETA(A) =} (0,1,2) for the theta 
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' part, similarly for omega and sigma 

' afterward, well need to sort out A, B etc and put the $THETA, $OMEGA and $SIMGA 
* element in proper order 

' and mover the {$THETA(A)= } TO AFTER THE VALUES 
Dim done As Boolean, this_int As Integer 
If this_run> 15 Then 
MsgBox "Pause" 
End If 

Dim this_token_set As Integer 
Dim this_token As Integer 

Dim new_code As String. new_string As String, oId_string As String 
new_code = ga_code 
Dim test_string As String 
done = False 

While Not (done) ' loop here until no more token_stem(*) is found 

' this will loop trough the non-omega genes 

For this_token_set = 1 To n_token_groups 
For this_token = I To token_collection(this_token_set).n_tokens 
old_string = token_col lection (this_token_set). stem & "(" & this_token & ")" 
new_string = token_collection(this_token_set).get_token(values(this_token_set), this_token) 
new_code = sub_string(new_code, old_string, new_string) 

* frm_text.txt__text = new_code 

* frm_text.Show 1. frm_main 
Next this_token 

Next this_token_set 

' check to see if we are done 

' loop over token_set stem to look for more tokens 

' look for token_set.stem & (1-9) 

done = True 

For this_token_set = 1 To n_token_groups 
For this_int - 1 To max_theta 

test_string = token_co11ection(this_token_set).stem & "(" & Trira(str(this_int)) & 
* if test_string is in code, then not done 
frm_texLtxt_text = new_code 
'fnn_text.Show 1, frm_main 

If InStr(l, new_code, test__string, vbTextCompare) <> 0 Then 
done = False 

Exit For 

End If 
Next this_int 

If done = False Then Exit For 
Next this_token„set 
Wend * end of loop over 

' now the final editting, replace the {crlf} with real crlf 

new_code - add_crlf(new_code) 
If MsgBox(new_code, vbOKCancel, "before match_reference") = vbCancel Then End 

' match up the THETA(A) with correct THETA(l)'s 

new_code = match_references(new_code) 

* sort the resulting theta, etas, sigmas 

new_code = sorter(new_code) 
' finally, swap $THETA= to end of line 

new_code - swapper(new_code) 
If MsgBox(new_code, vbOKCancel, "final") = vbCancel Then End 

' now, if omega_block is true, first remove the all omega parts and substitute the omega BLOCK(n) parts 
If omega_block = True Then 
' sustitute the BLOCK syngtax 
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firm_text.txt_text = new_code 
trm_text.Show 1 , frm_main 
new_code = sub_omega_block(new_code, values) 
End If 

make_control = new__code 
MsgBox new„code 
End Function 

Function sub_omega_block(code As String, values() As Integer) As String 

Dim block_part As String, n_etas As Integer 

Dim omega_start As Integer, n As Integer 

Dim otnega_end As Integer, this_gcne As Integer 

Dim start_pos As Integer, end_pos As Integer 

Dim init_omega() As Single: ReDim init_omega(l To n_omega) 

Dim sequencesQ As Integer: ReDim sequences(l To n_omega - 1) ' sequence of omegas, all possible etas 
(ie max omega, n_omega) 

Dim new_sequences() As Integer 'the sequences specefic for this control 

* sequence will have max_omega values 
Dim left_part_code As String. right_part_code As String ' left and right parts of code, without the omega 
block 

Dim covar_values() As Boolean: ReDim covar_values(l To n_omega - 1) * is this row in a block with the 
row above? does not include first row 

'read in covar_values() go ahead an read in all , even though well only use some 
For this_gene - 1 To n_omega - 1 

If values(this_gene + n_non_omega_genes) = 2 Then 

covar_values(this_gene) = True 

End If 
Next this_gene 

' while were here, read in sequences 
For this_gene = 1 To n_omega - 1 

sequences(this_gene) = values(this_gene.+ n_non__omega_genes + n_omega - 1) 

' while we Ye here, read in sequences 
Next this_gene 

Veil need to compress the sequence of the first n sequence values into 1 to n 

* e.g. if we have 4 etas in this control, but max_omega = 7, and sequence is 5,6,3,1,24 
' we compress the first 4 into 3,4,2,1 

* so we need to figure out how many etas in this control file. 
n_etas = count_etan(code) 

¥mi_text.txt_text = code 

frm_text.Sho w 1 , frm_main 

' first cut out the omega block 
omega_start= InStr(l, code, "$OMEGA") 
omega_end = InStr(l, code, "$SIGMA") - 1 
left__part_code = Left(code, omega_start - 1) 
¥rm_texLtxt_text = left_part_code 
"frm^textShow 1, frm_main 

right_part_code = Right(code, Len(code) - omega_end) 
frm_text.txt_text = right_part_code 
*frm_text.Show 1, frm_main 

block_part = Mid(code, omega_start, omega_end - omega_start) 
l frm_texttxt_text = block_part 
5 frm_text.Show 1, frm_main 
1 remove $OMEGA 

bIock_part = Right(block_part, Len(block_part) - 7) '7 for the SOMEGA 
Yrm_text.txt_text = block_part 
*frm_text.Show 1, frm_main 



Replacement Sheet 

09/878,686 
Group Art Unit 2123 

FIG. 8A-19 

' remove all parts between ; and vbcrlf 

While InStr(l t block__part, ";") o 0 

5 If this_run = 4 Then 

' frm_text.txt_text = block_part 

' frm_textShow 1, frm_main 

1 End If 

start_pos = InStr(l, block_part, '*;") - 1 

* find end of line 

end_pos = InStr(start_pos, block_part, vbCrLf) 
If end_pos = 0 Then end_pos = Len(block_part) 
'MsgBox Left(block_part, start_pos) 

block_part = Left(block_part, start_pos) & Right(block_part, Len(block_part) - end_pos) 
MsgBox block_part 
Wend 

block_part = Trim(block_part) 

* now get the values for omega' just read the (??) values 
' find pairs between ( and ) and read into init_omega 
start_pos = I : n = 1 

While InStr(start_pos, block.part, "(") <> 0 
start_pos = InStr(start_pos, block.part, M (") + 1 
end_pos = InStr(start_pos, block_part, ")") 

init_omega(n) = Val(Mid(block_part, start_pos, end_pos - start_pos)) 

n = n+ 1 

Wend 

' and resequence them 

' if there are no etas exit, will cause a crash in nonmem, but that's ok 
If n_etas > 0 Then 

ReDim new_sequences(l To n_etas) 
Else 

sub_omega_block - code 
Exit Function 
End If 

'read in the new sequences from the sequenes 

' loop over sequences, looking for values 1 to n_etas. 

* note that sequences has n_omega -1 elements, the final 

* posiiton is determined by the others 

Dim cur_eta_count As Integer ' count of non-zero elements 
Dim n_etas_left As Integer ' how many etas are left to fill 

Dim i As Integer, cur_eta_position * current position in new_sequences being examined (to see if = 0) 
n_etas Jeft = n_etas 

For i = 1 To n_etas ' looking for ETA(i) in main code 
' get the values from sequences 
cur_eta__position = sequences(i) 

If cur_eta_position > n_etas_left Then cur_eta_position = n_etas_left 
cur_eta_count = 0 
For n = 1 To n_etas 

If new_sequences(n) = 0 Then cur_eta_count = cur_eta_count + 1 
If cur_eta_count = cur_eta_position Then 
new_sequences(n) = i 
n_etas_left = n_etas Jeft - 1 
Exit For 
End If 
Next n 
Nexti 

' substitute the etas 

' first change THETA to XXXXX 
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' frm_text.txt_text = code 
'frmjext-Show 1, frm__main 

lefLpart.code = sub_string(left_part__code, "THETA", "XXXXX") 

Dim new_string As String, old_string As String ' new string will be " YYY(" to prevent re- replacement 
For i = 1 To n_etas 

old.string = "ETA(" & Trim(str(i)) & ")" 
new_string = "YYY(" & Trim(new_sequences(i)) & ")" 
left_part_code = sub_string(left„part_code, okLstring, new_string) 
Nexti 

'and replace the "YYY(" with "ETA(" 

left_part_code = sub_string(left_part_code, "YYY(", "ETA(") 
left„part_code = sub_string(left_part_code t "XXXXX", "THETA") 
¥rm_text.txt_text = left_part_code 
1 frm_text.Show 1, frm_main 
* and write the new block 
' build new omega block 

Dim new_omega_block As String, this„column As Integer 
Dim this_row As Integer, cur_end_row As Integer 
Dim cur_row_count ' how many rows in this block 
Dim off_diag As String 

this_column = 1 : thisjrow = 1 
cur_end__row = 1 
While cur_end_row <= n_etas 

' is this a new block, if so how big? 

1 loop through covar_values until you find a false 

cur_row_count = 1 

>************************************** 

>************ Part t0 put j nt0 0 ^ p ro ject 
>**************************************** 

Do While covar_values(cur_end_row) And cur_end__row < n_etas 

cur_row_count = cur_row_count + 1 

cur_end_row - cur_end_row + 1 

If cur_end_row > n_etas Then Exit Do 
Loop 

* need to see if we have exceeded the number of etas 
If cur_end_row > n_etas Then cur_end_row = n_etas 
If cur_row_count = 1 Then 

new_omega_block = new_omega_block & "$OMEGA M & vbCrLf 
Else 

new_omega_block = new_omega_block & "$OMEGA BLOCK(" & Trim(str(cur_row_count)) & & 
vbCrLf 
End If 

For i = 1 To cur_row_count 

* construct off diagonal elements 
ofLdiag = " " 

For n = 1 To i - 1 

ofLdiag = off_diag & " (0.00001) " 
Next n 

new_omega_block = new_omega_block & off_diag & '•(" & init_omega(l) & ")" & vbCrLf 
Nexti 

'MsgBox new_omega_block 

cur_end_row = cur_end_row + 1 
Wend ' this_row 

sub_omega_block = left_part_code & new_omega_block & right_part_code 
'frm_text.txt._text - left_part_code & vbCrLf & new_omega_block & vbCrLf & right_part_code 
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1 frm_text.Show 1, frrn_main 
End Function 

* and sequence the etas 

Function sequence_omegas(code As String) 
sequence_omegas = code 
End Function 
Function sorter(ByVaI code As String) As String 

* this function sorts the theta,omegas and sigma initial estimates 
Dim new_code As String, cut_out As String, this_prefix As Integer 

Dim slack(l To max_theta) As String, stack_order(l To max_theta) As Integer 
Dim new_cut_out As String, token As String 

Dim first_position As Long, last_position As Long, next_position As Long 

Dim cur_prefix As String, position As Long 

Dim prefixes(l To 3) As String, stack_position As Integer 

prefixes(l) = "{$THETA(": prefixes(2) = "{$ETA(": prefixes(3) = "($EPS(" 

Tf MsgBox(code, vbOKCancel, "in sorter") = vbCancel Then End 

Dim old_cut_out As String * need to preservie original cut out to use in sub_string 

new_code = code 

For this_prefix = 1 To 3 

Tf MsgBox(code, vbOKCancel) = vbCancel Then End 

If InStr(new_code, prefixes(this_prefix)) = 0 Then Exit For 

MsgBox new_code 

'collect all {THETA(?)=} (XXX)} 

'find the first {THETA 

first_position = InStr(l, new_code, prefixes(this_prefix)) 
last_position = first_position 
' then find end of theta section 

next_position = InStr(last_position + 1, new_code, prefixes (this_prefix)) 
While next_position o 0 

next_position = InStr(last_position + 1, new_code, prefixes(this_prefix)) 

If next_position <> 0 Then last_position = next_position 
Wend 

1 then find the end of the last theta string 

* note that you must end with a ")" 

* find the first " } " at the end of the string 
last_posttion = InStr(last_position, new_code, "}") 
'then the final T 

last_position = InStr(last_posiuon - 1, new_code, ")") + 1 
' cut out that section and sort it 
MsgBox new_code 

cut_out = Mid(new_code, first_position, last_position - first_position) 

old_cut_out = cut-out 'need to save old cut_out for substring, since we are about 

'to change cut_out. 

' remove all vbcrlf from cut_out 

cut_out = sub_string(cut_out, vbCrLf, "") 

MsgBox cut_out 

'assemble the stack of values 

* find the lowest value, put it in stack(l) etc, 

Dim i As Integer, cur_start As String, n As Integer, token 1 As String, token2 As String, token3 As String 
For i = 1 To max_theta 

cur_start = prefixes(this_prefix) & i & ")=}" 

first_position = InStr(l, cut_out, cur_start) 

* seperate each token (from $theta to before next $theta) and put then on a stack to be sorted. 
If first_position <> 0 Then 

stack__position = stack_position + 1 ' next stack position 
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* find the start of the next token, or the end of cut_out string 

last_position = InStr(first_position + 5, cut_out, "{$*') - 1 ' 

If last_position < 0 Then last_position = Len(cut_out) 

token = Mid(cut_out, first_position, last_position - first_position + 1) 
' token 1 = Mid(cut_out, first_position + Len(cur_start), _ 
' last_position - first_position - Len(cur_start)) 
' token2 = " ;" & Mid(cut_out, first_position, Len(cur_start)) 

stack(stack_position) = token 

stack_order(stack_position) = i 
End If 
Nexti 

• put cut out back together 
new_cut_out = "" 

For i = 1 To stack_position 

new_cut„out = new_cut_out & stack(i) & vbCrLf & " " 
Next i 

new_code = sub_string(new_code, old_cut_out, new_cut_out) 
new_cut_out= 

' MsgBox Mid(new_code, 500, Len(new_code) - 500) 
stack_position = 0 
Next this_prefix 
sorter = new_code 
End Function 

Private Function swapper(code As String) As String 
' this function puts the {$THETA(?)} after the value 

Dim this_prefix As Integer, position As Integer, eol As Integer, stop_pos As Integer 

Dim cut_out As String, rest_str As String, new_str As String, first_part As String 

Dim prefixes(l To 3) As String: prefixes(l) = "{$THETA(": prefixes(2) = M {$ETA(": prefixes(3) = 

"{$EPS(": 

For this_prefix = 1 To 3 
' loop over the text looking for prefix 
position = InStr(l, code, prefixes(this_prefix)) 
While position <> 0 

* now find end of line 

stop_pos = InStr(position, code, "}") 

eol = InStr(stop_pos, code, vbCr) - 1 

cut_out = Mid(code, position, eol - position + 1) '+ 1) 

stop_pos = InStr(position, code, "}'') 

rest_str = Trim(Mid(code, stop_pos + 1, eol - stop_pos)) 

first_part = Trim(Mid(code, position, stop_pos - position)) 

Mid(first_part, 1,2) = ";;" 

new_str = rest_str & firsLpart 

code - sub_string(code, cut_out, new_str) 

position = eol - 3 

position = InStr(l, code, prefixes(this_prefix)) 
Wend 

Next this_prefix 
swapper = code 
End Function 

Function match_references(ByVal code As String) 

f match up (THETA(A) with {THETA(A) =}(xxxx) to figure out which theta (eta) this is 
'and ETA(A) with {ETA(A) = } XX 
' and also sigma 

Dim this_prefix As Integer, integer_used As Boolean 

Dim position As Long, cur_prefix As String, next_value As Integer 
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Dim curjetter As Integer, cur_integer As Integer, cur_string As String 
Dim cur_new_string As String, cur_old_string As String 
Dim vtheta_used As Boolean 

' first pass through the data to find out which theta, eta and eps is available 

• Do theta first note that ETA is substring of THETA 

'ETA is in THETA, so well first change "THETA" to "XXXXX", do eta then change back 
code = sub_string(code, "THETA", "XXXXX") 

* MsgBox (code) 

Dim prefixe$(l To 3) As String: prefixes(l) = "ETA": prefixes(2) = "THETA": prefixes(3) = "EPS" 
For this_prefix = 1 To 3 

cur_prefix = prefixes(this_prefix) 

' find out if there are any fixed thetas (i.e., theta(l)) 
*frm_text.txt_text = code 
TrmJext.Show 1, frm_rnain 

' MsgBox (code) 
cur_string = cur_prefix & "(l)" 
position = InStr(code, cur_string) 
cur Jnteger - 1 

' find first available theta value 
While position > 0 

cur Jnteger = cur Jnteger + 1 

cur_string = cur_prefix & & cur_integer & ")" 

position = InStr(code, cur_string) 
Wend 

* assign lowest available number 
next_value = cur_integer 

> MAIN LOOP THROUGH CODE TO SUBSTITUTE THETA(3) FOR THETA(A) 
' now loop through each posible value to variable theta (theta(a) to theta(z) 
' NEED MORE LETTER THAN 26 
For curjetter = AscfA") To Asc("Z") 
vtheta_used = False 
' get new theta string 

cur_new_string — cur_prefix & "(" & cur_integer & ")" 
' get old variable theta string 

cur_old_string = "{'' & cur_prefix & "(" & Chr(curjetter) & ")}" 
position = InStr(l, code, cur_old_string) 
While position > 0 
vtheta_used = True 

code = sub_string(code, cur_old„string, cur_new_string) 
' MsgBox code 

position = InStr(l, code, cur_old_string) 
Wend 

' now do {theta(A)=} part 

' right now well just replace, will need to sort and put theta(l) part 
* at the end later. 

cur_new_string = "{$" & cur_prefix & M (" & curjnteger & ")=}" 
cur_old_string = "{$" & cur.prefix & & Chr(curjetter) & ")=}" 
position = InStr(l, code, cur_old_striug) 
While position > 0 

code = sub_string(code, cur_old_string, cur_new_string) 

position = InStr(l, code, cur_old_string) 
Wend 

' we want to increment curjnteger only if variable theta is used 
If vtheta_used = True Then curjnteger = curjnteger + 1 
Next curjetter 
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'NOW THETA(AA) TO THETA(AZ) 

For curjetter = AscfA") To AscfZ") 
vtheta_used = False 
' get new theta string 

cur_new_string = cur_prefix & "(" & cur_integer & ")" 
' get old variable theta string, WITH THE "A" 
cur_old_string = " { " & cur_prefix & "(A" & Chr(curjetter) & ") } " 
position = InStr(l, code, cur_old_string) 
While position > 0 
vtheta_used = True 

code = sub_string(code, cur_old_string, cur_new_string) 
' MsgBox code 

position = InStr(l, code, cur_old_string) 
Wend 

'now do {theta(AA)=} part 

' right now well just replace, will need to sort and put theta(l) part 
' at the end later. 

cur„ne\v_string = "{$" & cur_prefix & & cur Jnteger & ")=} " 
cur_old„string = "{$" & cur_prefix & "(A" & Chr(curjetter) & ")=}" 
position = InStr(l, code, cur_old_string) 
While position > 0 

code = sub_string(code, cur_old_string, cur_new_stiing) 

position = InStr(l, code, cur_old_string) 
Wend 

' we want to increment curjnteger only if variable theta is used 
If vtheta__used = True Then curjnteger = curjnteger + 1 
Next curjetter 



* NEXT PREFIX 

• change XXXX back to THETA if we just did theta 

If this.prefix = 1 Then code = sub_string(code, "XXXXX\ "THETA") 
Next this_prefix 

If MsgBox(code, vbOKCancel, "end of match_ref ') = vbCancel Then End 
match_references = code 
End Function 

Function add_crlf(ByVal code As String) As String 

'replace the {crlf} with vbcrlf 

Dim where As Long 

where = InStr(l, code, "{crlf}") 

While where > 0 

code = sub_string(code, "{crlf}", vbCrLf) 
where = InStr<l, code, "{crlf}") 
Wend 

add_crlf = code 
End Function 

Function sub_string(code As String, old_str As String, new_str As String) As String 
' first check to see if code has changed 
If InStr(new_str, old_str) > 0 Then 

sub_string = code 
Else 

' this function replaces all instances of old_str with new_str 

Dim position As Long, new.code As String, left_part As String, right_part As String 
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position = InStr(l, UCase(code), UCase(old_str)) - 1 
new_code = code 
While position > 0 
left_part = Left(new_code, position) 

right_part= Right(ne\v_code, Len(new_code) - position - Len(old_str)) 

new_code = left_part & new_str & right_part 
position = InStr(position, new_code, old_str) - 1 
Wend 

MsgBox (sub_string) 
MsgBox (ne\v_str) 
MsgBox (old_str) 

sub_string = new_code 
End If 

MsgBox (sub_string) 
End Function 



Function count_non_omega_genes() 
count_non_omega_genes = n_token_groups 
End Function 

Function count_omega_genes() 
If omega_block = True Then 
n_omega = count_max_omega 
count_omega_genes = 2 * (n_omega - 1) 

' n_omega genes for the sequence (n_omega-l)! and n_omega -1 for the block definition 
Else 

count_omega_genes = 0 
End If 

End Function 

Function count_non_omega_bits() 

Dim i As Integer 

Dim n As Integer 

For i = 1 To n_token_groups 

' one token set requires no genes, two requres 1 , 3 or 4 requires 2, 5 to 8 requires 3 
' basically, ceiling(log base 2(n_token_sets) 

n = n + CInt(Log(token - .collection(i).n_token_sets) / Log(2) + 0.499999) 
Nexti 

count_non_omega_bits = n 
End Function 

Function count_omega_bits() 

Dim i As Integer 

Dim n As Integer 

If omega_b!ock = True Then 

n = n_omega - 1 'for the block part, one bit per gene (is this in a block with the row above?) 
' sequence part (n-1) ! 
For i = n_omega To 2 Step - 1 

'eta(l) can be in n_omega possible values, eta(2) can be in n_omega -1 etc, 
1 to eta(n_omega) which is fixed 
n = n + CInt(Log(i) / Log(2) + 0.499999) 
Nexti 

count_omega_bits = n 
Else 

count_omega__bits = 0 
End If 

End Function 
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Sub randomizer(ByRef genome() As Boolean) 

Dim i As Integer, n As Integer 

Randomize 

For n = 1 To pop_size 

For i = 1 To UBound(genome, 2) 
genome(n, i) = CInt(Rnd()) 

Next i 
Next n 
End Sub 



Public Sub save_model(file_naine As String) 
1 get file name 
' need to save: 
' control file 

* genome 

' token set 
' options 

*first> control file 
n_models = 1 

Dim i As Integer, n As Integer, p As Integer 
file_name = home_directory & "Y* & file_name 
Open file_name For Output As # 1 
Print #1, "Number of models = " & vbCrLf & n_models 
For i = 1 To n_models 

Print #1, "########### Begining of model # " & i & " ############" 
Print #1, frm_main.txt_code 

Print #1 , "########### End of model # " & i & " ################" 
Nexti 

Print #1, "### End of GA code ###" 

Print #1, " Last gen", vbCrLf, last_gen 

Print #1, "### Start of genome ###" 

Dim gen_str As String 

If run_number = 0 Then 

Print #1, "Genome not defined" 

Else 

Dim n_bits As Integer 

n_bits = count_omega_bits() + count_non_omega_bits() 
Print #1, M N bits = \ vbCrLf, UBound(genome, 1) 
Print #1, "Pop size = vbCrLf, UBound(genome, 2) 

* genome is n_bits by pop size 
For i = 1 To UBound(genome, 1) 

For n = 1 To UBound(genome, 2) 

gen_str = gcn_str & " " & -Int(genome(i, n)) ' - because fals = 0, true = -1 
Next n 
Print #1, gen_str 
gen_str = 
Nexti 
End If 

Print #1, "### End of genome ###" 
Print #1, "### Begining of tokens ##T 
For i = 1 To n_token_groups 

Print #1 , "Group stem = vbCrLf, token_collection(i).stem 

Print #1, "N token sets = \ vbCrLf, token_collection(i).n_token_sets 

Print #1, "N tokens = vbCrLf, token_collection(i).n_tokens 
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For n = 1 To token_collection(i).n_token_sets 
Print #1, "Token set # vbCrLf, n 

For p = 1 To token_coliection(i).n_tokens 

Print #1, token_collection(i).get_token(n, p) 

Next p 
Next n 
Nexti 

Print #1, "###End of tokens ###" 

Print #1, "### Begining of options ###" 

Print #1, "cross_over_freq M , vbCrLf, cross„over_freq 

Print #1, M mutation_rate\ vbCrLf, mutation_rate 

Print #1, "frame shift prob", vbCrLf, frame_shift_prob 

Print #1, "njruns", vbCrLf, n_runs 

Print #1, ,, theta_crit , \ vbCrLf, theta_crit 

Print #1, ,i omega_crit , \ vbCrLf, omega_crit 

Print #1, "sigma_crit", vbCrLf, sigma_crit 

Print #1, "cov_crit\ vbCrLf, cov_crit 

Print #1, "pop_size'\ vbCrLf, pop_size 

Print #1, "generationjimit", vbCrLf, generationjimit 

Print #1, "calLmethod", vbCrLf, calLmethod 

Print #1, "upper fitness limit", vbCrLf, upper_fitness_limit 

Print #1, " lower Jltnessjimit", vbCrLf, lower Jitnessjimit 

Print #1, "correlation criteria", vbCrLf, corr_crit 

Print #1, 1, success_criteria'\ vbCrLf, success_crit 

Print #1, "save control", vbCrLf, save_control 

Print #1, "save best", vbCrLf, save_best 

Print #1, "save output' 1 , vbCrLf, save_output 

Print #1, "omega block", vbCrLf, omega_block 

Print #1, "seed type", vbCrLf, seedjype 

Print #1, "seed value", vbCrLf, seed_value 

Print #1, "### End of options ###" 

Print #1, " lllltllltilimUMiliillllilM i ntl tW' 

Close #1 

End Sub 

Sub get_model(file As String) 

Dim textline As String, code As Suing, n As Integer, n__bits As Integer 
Dim n_token_sets As Integer 

Dim i As Integer, token_set„num As Integer, token_num As Integer 

For i = 1 To n_token_groups 

token_collection(i).clear 

Nexti 

n_token__groups = 0 
^0^6) = "" Then 

MsgBox ("File not found") 

Exit Sub 
End If 

' * see if it is on the start_flles 
' For i = 1 To njiles 
' If start_files(i) = file Then 
For n = i To n_files - 1 
start_files(i) = start_files(i + 1) 
' frm_main.files(i).Caption = start_files(i) 
' Next n 

' start_files(n_fiies) = ,,M 

* frm_main.files(n_files).Visible = False 
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' n_files = n_files - 1 

* End If 

* Next i 

************************* 



For i = 1 To n_files 
If start_fdes(i) = file Then 
' remove it 
For n = i To n_files - 1 Step 1 

start_files(n) = start_files(n + 1) 
Next n 

n_files = n_fi!es - 1 

start_files(n_files + 1) = "" 

Exit For 
End If 
Next i 

If n_files < 4 Then n_files = n__files + 1 
For i = n_files To 2 Step -1 
start_files(i) = start_files(i - 1) 
fxm_main.files(i).Caption = start_files(i) 
Next i 

start_files(l) = file 

frm_main.files(l).Caption = start_files(l) 
**************** 



Open file For Input As #1 

Line Input #1. textline 'Number of models = 
Line Input #1, textline ' number of models 
n_models = Val(textline) 
Line Input #1 , texdine * number of models 

code = nn 

For i = 1 To n_models 

Line Input #1, textline ' number of models 

While Left(textline, 24) o "########### End of model" 

code = code & textline & vbCrLf 

Line Input #1, texdine 
Wend 

frm_main.txt_code = code 
Nexti 

Line Input #1, textline W## end of ga code ### 
Line Input #1, textline last_gen 
Line Input #1, textline 
last_gen = Val(textline) 

Line Input #1, textline W## Start of genome ### 
Line Input #1, textline 

If Trim(textline) o "Genome not defined" Then 
Line Input #1, textline 
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n_bits = Val(textline) 
Line Input #1, textline 
Line Input #1, textline 
pop_size = Val(textiine) 
Dim value As Integer 

ReDim genome(l To n_bits, 1 To pop_size) 
For i = 1 To n_bits 

For n = 1 To pop_size 

Input #1, value 

genome(i, n) = Val(value) 

Nextn 
Next i 
End If 

Line Input #L textline *## Begining of tokens ### 
While Trim(textline) o "### Begining of tokens ###" 

Line Input #1, textline 
Wend 

While Trim(textline) o "### End of tokens ###" 

While Trim(textline) o "Group stem =" 
Line Input #1, textline 
Wend 

Line Input #1, textline 
n_token_groups = n_token_groups + 1 

token_collection(n_token„groups).stem = Trim(textline) 'i.e., clear 

frrnJokens.lst_token _group. Addltem Trim(textline) 
While Trim(textline) o "N token sets =" 

Line Input #1, textline 
Wend 

Line Input #L textline 
n_token_sets = Val(textiine) 
While Trim(textline) o M N tokens =" 
Line Input #1, textline 
Wend 

Line Input #1 , texdine 

token_collection(n_token_groups).n_tokens = Val(textline) 
While Trim(textline) o "Token set#" 
* Line Input #1 , textline 
Wend 

Line Input #1, textline 
loken.set.num = Val(textline) 
For n = 1 To n_token_sets 
While Trim(texdine) o "Token set #" 
Line Input #1, textline 
Wend 

Line Input #1, textline 
token__set_num = Val(textline) 

token_coUection(n_token_groups).add_token_setfrm_tokens.ist_token_sets 
token_num = 0 

For i = 1 To token_collection(n.token_groups).n_tokens 

Line Input #1 , texdine 
token_num = token_num + 1 

token__collection(n_token_groups).set_token token_set_num, token_num, textline 
Next i 
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Nextn 

token_num = 0 
Line Input #1 . textline 
Wend 

frm_tokens.Ist_token_group.clear 
For i = 1 To n_token_groups 

frm_tokens.lst_token_group. Addltem token_collection(i) .stem 
Nexti 

Line Input #1, textline W## Begining of options ### 
Line Input #1 , textline 

While Trim(textline) <> "### End of options ###" 

code = Trim(textline) 
Line Input #1 , textline 
textline = Trim(textline) 
Select Case code 
Case "mutation_rate" 

mutation_rate = Val(textline) 
Case "cross_over_freq" 

cross_over_freq = Val(textline) 
Case "frame shift prob" 

frame_shift_prob = Val(textline) 
Case "n_runs" 

n_runs = Val(textline) 
Case "theta_crit M 

theta_crit = Val(textline) 
Case "omega_crit M 

omega_crit = Val(textline) 
Case "sigma_crit" 

sigma_crit = Val(textline) 
Case "cov_crit" 

cov_crit = Val(textline) 
Case "success.criteria" 

success_crit = Val(textline) 
Case "pop_size" 

pop_size = Val(textline) 
Case "generationjimit" 

generation Jimit = Val(textline) 
Case "cail„method" 

call_method = Trim(textline) 
Case "upper fitness limit" 

upperjitness Jimit - Trim(textline) 
Case "lower_fitnessJimit" 

lower Jitness Jimit = Trim(textline) 
Case "correlation criteria" 
corr_crit = Trim(textline) 

Case "save control" 

save_control = Trim( textline) 
Case "save best" 

save_best = Trim(textline) 
Case "save output" 

save__output = Trim(textline) 
Case "omega block" 
omega_block = Trim(textline) 
Case "seed type" 
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seedjype = Trim(textline) 
Case "seed value" 
seed_value = Trim(textiine) 
End Select 

Line Input #1 , textline 

Wend 

Close #1 

' update options 

End Sub 



'Sub scale_fitness(fitnessO As Single) 

' ' scale by emax, with max fitness at 90% of emax and min fitness at 10% of emax 

* * first find min and max 

'Dim max_fit As Single, min_fit As Single, ef50 As Single, sum Jit As Single 
'Dim i As Integer, n As Integer 
'Dim emax As Single, emin As Single 
' emin = 0.2 

' n = UBound(fitness) - LBound(fitness) 
'max_fit= -999999 
' min_fit = 999999 

'For i = LBound(fitness) To UBound(fitness) 
' If fitness(i) > maxjit Then max_fit = fitness(i) 

* If fitness(i) < min Jfit Then min_fit = fitness(i) 
' surnjit - sum_fit + fitness(i) 

'Nexti 

'emax = sum_fu * 2 / n 
'ef50 = sum_fit/n 
'emin = sum_fit * 0.2 / n 

'For i = LBound(fitness) To UBound(fitness) 

' fitness(i) = emax * fitness(i) A 2 / (ef50 A 2 + fitness(i) A 2) + emin 
'Nexti 

'MsgBox emax & Chr(9) & ef50 & Chr(9) & emin 
'End Sub 



Private Sub map_run() 

Dim n_ind As Integer, this_generation As Integer, max_generation As Integer 

Dim max_values() As Integer 

Dim mapped_values() As Integer 

Dim valuesO As Integer 

Dim binaryO As Boolean 

Dim n_genes As Integer 

Dim n_bits() As Integer 

'Dim bin Jength As Integer 

'n_genes = 5 

, max_generation = 6 

'n_ind = 3 

HeDim max_values(l To n__genes) 
*ReDim values(l To n_genes, 1 To n_ind) 
HeDim mapped_values(l To n_genes, 1 To n_ind) 
'max_values(l) = 5 
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1 max_values(2) = 2 

max_values(3) - 4 

teax_values(4) = 3 

'max_values(5) = 9 

UeDim binaiy(l To 12, 1 To n„ind) 

HeDim n„bits(l To n_genes) 

Values(l, 1) = 1: values(l, 2) = 1: values(l, 3) = 5 

Values(2, 1) = 2: values(2, 2) = 2: values(2, 3) = 1 

Values(3, 1) = 3: values(3, 2) = 3: values(3, 3) = 1 

Values(4, 1) = 2: values(4, 2) = 1: values(4, 3) = 3 

Values(5, 1) = 7: values(5, 2) = 6: values(5, 3) = 1 

'n_bits(l) = 3 
'n_bits(2) = 1 
^n.bitsCS) = 2 
'n_bits(4) = 2 
>nj>its(5)=4 
"generate random 

Dim new_valuesO As Integer 

Dim fltness() As Single 

ReDim fitness(l To njnd) 

HeDim new_values(l To n_genes, 1 To n_ind) 

Dim p_cross_over As Single, p_mutation As Single 

^cross^ver = 0.8: p_mutation = 0.4 

^**************************************** 

" loop over generations here 

For this_generation = 1 To max_generation 
' uncode mapped_values s n_bits 

' unmap new_values, rnax_values. mapped.values, n_bits 
f ' create control file 
' 'evaluate fitness 

* fitness(l) = 0.2 
' fitness(2) = 0.6 
» fitocss(3)=l# 

* * scale fitness 

' * scaler fitness 

1 ' select pairs by fitness and cross over 

' bross_over_genes fitness, binary, p_cross_over 

' mutate genome, p_rautation 

*************************************************** 
" end of generation loop 

^************************************************ 
Tsfext this_generation 

"map values, max_values, mapped_values, n_bits 
"code binary, mapped_values, njrits 
" next we creat the population 



Dim tstr As String, i As Integer 

For i = LBound(new_values) To UBound(new_values) 

tstr = tstr & new_values(i, 3) & Chr(9) & values(i, 3) & vbCrLf 

Nextt 

TvlsgBox tstr 

" note that 0000 = 1, 0001 = 2 etc.we start at value = 1 
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End Sub 

'Sub map(values() As Integer, max_values() As Integer, mapped_values() As Integer, n_bits() As Integer) 

"take unmapped values (I to rnax_values) to mapped (0 to 2 A ngenes -1) 

" values() is 2 dimensional, (n_genes by n_subject) 

"max_valus is 1 dimension (n_genes) 

" mapped values is 2 dimensional (n_genes by n_subject) 

" n_bits() is I dimensino, (n_genes) 

Dim i As Integer, n As Integer, p As Integer 

" n_bits = 1, max_value = 2;repeat = 0 

" 1 -> 0 ;2 -> 1 

" n_bits = % max_value = 3; repeat = 1 

M 1 -> 0 ;2 -> 2: 3 -> 3 

M n_bits = 2, max_value - 4; repeat = 0 

" 1 ->0;2-> 1: 3->2;4->3 

" n_bits = 3, max„value = 5; repeat - 3 

" l->0;2->2: 3 -> 4; 4 -> 6; 5 -> 7 

" n_bits - 3, max_ value = 6; repeat = 2 

" l->0;2->2: 3 -> 4; 4 -> 5; 5->6;6 -> 7 

M n_bits = 3, max_value = 7; repeat = 1 

* 1 -> 0 ;2 -> 2: 3 -> 3; 4 -> 4; 5 -> 5; 6 -> 6; 7->7 
" n_bits = 3, max_value = 8; repeat = 0 

" 1 ->0 ;2-> 1: 3 -> 2; 4 -> 3; 5 -> 4; 6 -> 5; 7->6; 8->7 
w n_bits = 4, max_value = 9; repeat = 7 

" 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 8; 6 -> 10; 7->12; 8->14; 9 -> 15 
19 n_bits = 4, max_vaiue =10; repeat = 6 

" 1 -> 0 ;2 -> 2: 3 ~> 4; 4 -> 6; 5 -> 8; 6 -> 10; 7->12; 8->13;9->14; 10 -> 15 
M n_b»ts = 4, max_ value = 1 1 ;repeat - 5 

n 1 -> 0 ;2 -> 2: 3 ->4; 4 -> 6; 5 -> 8; 6 -> 10; 7->ll; 8->12;9->13; 10 -> 14; 11->15 
" n_bits - 4, max_value = 12;repeat = 4 

" 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 8; 6 -> 9; 7->10; 8->ll;9->12; 10 -> 13; 11->14;12->15 
" njrits = 4, max_value = 13;repeat = 3 

" 1 -> 0 ;2 -> 2: 3 -> 4; 4 -> 6; 5 -> 7; 6 -> 8; 7->9; 8->10;9->ll;10 -> 12:1 1->13;12->14;13->15 
" n_bits = 4, max_value = 14;repeat = 2 

" 1 -> 0 ;2 ->2: 3 -> 4; 4 -> 5; 5 -> 6; 6 -> 7;7->8; 8->9;9->10;10 -> 1 1;11->12;12->13;13->14;14->15 

Dim repeated As Integer, this_pop As Integer 

For this_pop = 1 To UBound( values, 2) 

For i = LBound(values, 1) To UBound(values, 1) 

'repeated = 2 A n_bits(i) - max_values(i) 

" want 2 * values up to repeated, then 1 * value 

If values(i, this_pop) <= repeated + 1 Then 

* mapped_values(i, this_pop) = (values(i, this_pop) - 1) * 2 
Else 

' mapped_values(i, this_pop) = (repeated) * 2 + (values(i, this_pop) - repeated - 1) 

End If 

Nexti 

Next this_pop 
End Sub 

Sub urunap(values() As Integer, max_values() As Integer, mapped„values() As Integer, n_bits() As Integer) 

'take mapped values (0 to 2 A ngenes -1) back to unmapped (1 to max_values) 

' valuesO is 2 dimensional, (n_genes by n_subject) 

'max_valus is 1 dimension (n_genes) 

1 mapped values is 2 dimensional (n_genes by n_subject) 

' n_bits() is 1 dimensino, (n_genes) 

Dim i As Integer, repeated As Integer, this_ind As Integer 
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For thisjnd = 1 To UBound(values, 2) 

For i = LBound(values, 1) To UBound(values, 1) 

repeated = 2 A n Jrits(i) - max_values(i) 

* have we reached the change over? 

If mapped_values(i, thisjnd) <= repeated * 2 Then 

values(i, thisjnd) = mapped_values(i, thisjnd) / 2 + 1 

Else 

values(i, this_ind) = mapped_values(i, this_ind) - repeated + 1 

End If 

Nexti 

Next thisjnd 
End Sub 

Sub code(binary() As Boolean, valuesO As Integer, n_bits() As Integer) 

Dim i As Integer, n As Integer, cur_val As Integer, thisjnd As Integer 

Dim start_pos As Integer, end_pos As Integer 

Dim bit_val As Integer ' value of current bit position 

start_pos = 1 

For this_ind = 1 To UBound( values , 2) 

For i = LBound(values ? 1) To UBound(values, 1) 
end_pos = start_pos + njrits(i) - 1 
cur_val = values(i, this_ind) 
For n = start_pos To end_pos 
bit_val = 2 A (end^pos - n) 
If cur_val >= bitjval Then 
binary(n, thisjnd) = True 
cur_val = cur_val - bitjval 
End If 
Next n 

start_pos = end_pos + 1 
Nexti 

start_pos = 1 
Next thisjnd 
End Sub 

Sub uncode(valuesO As Integer, nJbitsO As Integer) 

* takes genome and returns the values used for the control file 

* need to know how many bits in each gene (token group) 

Dim i As Integer, n As Integer, cur_val As Integer, thisjnd As Integer 

Dim start_pos As Integer, end„pos As Integer 

Dim bit_val As Integer ' value of current bit position 

For thisjnd = 1 To UBound( values, 2) 

start_pos = 1 

For i = LBound(values, 1) To UBound(values, 1) 
end_pos = start_pos + n_bits(i) - 1 
For n = startjpos To end_pos 
bit_val = 2 A (end_pos - n) 
If genome(n, this_ind) = True Then 

cur_val = cur_val + bit_val 
End If 
Next n 

values(i, this_ind) = cur_val 
cur_val = 0 

start_pos = end_pos + 1 
Next i 
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start_pos = 1 
Next this_ind 
End Sub 

Sub mutate(binaryO As Boolean, p_mutation As Single) 
Dim this_gene As Integer, thisjnd As Integer 
For this_gene = 1 To UBound(binary, 1) 
For thisjnd = 1 To UBound(binary, 2) 

If Rnd() < p_mutation Then binary(this_gene, thisjnd) = Not (binary(this_gene ; this_ind)) 

Next this_ind 
Next this_gene 
End Sub 

Function InStr_not(stringl As String, string2 As String, string3 As String) 
Dim position 1 As Long, position2 As Long, start As Long 
start = 1 

ftmJcstTextl = string 1 
s frm_test.Show 1 

positionl = InStr(start, stringl, string2) 
position2 = InStr(start, stringl , string3) 
While positionl > 0 

If position2 <= positionl And position2 + Len(string3) >= positionl + Len(string2) Then 

start = start + positionl 
End If 

positionl = InStr(start, stringl, string2) 
position2 = InStr(start, stringl, string3) 
Wend 

InStr_not = positionl 
End Function 

Function from_to(start As Long, stringl As String, from_string As String, to„string As String) As String 

' this function return the string that starts with from_string and ends with to_string, 

' starting the search at start 

Dim new_string As String 

Dim start_pos As Long, end„pos As Long 

' find the start 

start_pos = InStr(start, stringl, from_string) 
* then the end position 

end_pos - InStr(start_pos, stringl, to_string) 

new„string = Mid(stringl, start_pos, end_pos + Len(to_string)) 

from_to = new_string 
End Function 

Public Function call_nm(drivename As String, pathname As String, controlfile As String, _ 

objt As Single, succl As Integer, covar As Integer, limit_str As String, check-out As Boolean) As 
Double 

Dim fitness As Double 

Dim theta(l To max_theta) As Single, setheta(l To max_theta) As Single 
Dim lltheta(l To max_theta) As Single, ultheta(l To max_theta) As Single 
Dim omega(l To 30, 1 To 30) As Single, seomega(l To 30, 1 To 30) As Single 
Dim sigma(l To 30, 1 To 30) As Single, sesigma(l To 30, 1 To 30) As Single 
Dim obj(l To 2) As Single, rm(l To 69, 1 To 69) As Single 
Dim i As Integer 
Dim success(l To 2) As Single 
success(l) = 999 



Replacement Sheet 

09/878 5 686 
Group Art Unit 2123 

FIG. 8A-36 

success(2) = 999 

Dim a As Long, p As Integer, ntheta As Integer 
Dim out_val As Single 
ChDrive drivename 
ChDir pathname 

If controlfile o "control" Then FileCopy controlfile, "control" 
' need to sent check_out to nmv_exe if false then don t execute 

a = nmv_exe(theta(l), lltheta(l), ultheta(l), omega(l, 1), sigma(l, 1), obj(l), success(l), setheta(l), _ 
seomega(l > 1), sesigma(l, l),rm(l, 1)) 
fitness = calc_fitness(obj(), success(), setheta(), seomega(), sesigma(), rm()> _ 
theta_crit, omega_crit, sigma_crit, cov_crit, ntheta) 
run_number = run_number + 1 
' hit upper of lower limits? 

For i = 1 To ntheta 
If theta(i) o 0 Then * check for divide by zero 
If Abs(theta(i) - lltheta(i) / theta(i)) < 0.00000001 Or _ 
Abs(theta(i) - ultheta(i) / theta(i)) < 0.000000001 Then 
limit_str = limit_str & Trim(i) & V 
End If 
End If 
Nexti 

objl = obj(l): sued - success(l): covar = success(2) 
call_nm = fitness 
End Function 

Private Function calc_fitness(obj() As Single, success() As Single, setheta() As Single, _ 
seomega() As Single, sesigma() As Single, rm() As Single, _ 
theta_crit As Single, omega_crit As Single, sigma_crit As Single, _ 
cov_crit As Single, ntheta As Integer) As Single 

'return calculated value for fitness, start with obj, subtract theta_crit for each estimated theta etc 
Dim i As Integer, neff As Integer, n As Integer 
Dim nsigma As Integer 

Dim corr_pen As Single ' correlation > 0.95 penalty 
Dim cov_pen As Single 
'count theta, etas and sigmas 

5 read from file inputs, created by cfilex (and thetas) in nmtran 
Dim iline As String 
Dim s_pen As Single 

Dim nomega_sets As Integer, nomega As Integer 
Dim nsigma_sets As Integer 

Dim fixd As Integer, block_num As Integer, nval As Integer 
Dim nthfxd As Integer, nomfxd As Integer, nsgfxd As Integer 
MsgBox CurDir 

If Dir("INPUTS'^ vbNormal) <> " M Then 

Open "inputs" For Input As #1 

Else 

calcjitness = 999999999.99 
obj(l) = 999999999.99 
Exit Function 
End If 

Line Input #1, iline 

'FIRST LINE IS - NTHETA, NOMEGA, NSIGMA, NTHFXD, NOMFXD, NSGFXD" 
Input #1, ntheta, nomega_sets, nsigma_sets, nthfxd, nomfxd, nsgfxd 
Line Input #1, iline 
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' THIRD LIND IS " NOMBLK , OMDIM, OMFIX" 
For i = 1 To nomega_sets 
Input #1, block_num s nval, fixd 
' get # of etas in block 
If fixd = 0 Then 
For n = 1 To oval 
nomega = nomega + n 
Next n 
End If 'fixd = 0 
Next i 

Line Input #1, iline 
For i = 1 To nsigma„sets 
Input #1 , block_num, nval, fixd 
nsigma = nsigma + nval * (1 - fixd) 
Next i 

' loop through srm to see if any arc larger than 0.95 
neff = ntheta + nomega + nsigma 
corr_pen = 0 

If success(2) = 0 Then ' only do if cov step ran 
For i = 1 To neff 
For n = 1 To i - 1 ' only do lower triangle 
Ifrm(i, n)>0.95 Then 
corr_pen = corr_crit 
Exit For 
End If 
Next n 

If corr_pen > 0 Then Exit For 
Nexti 
End If 

' now calcuate fitness 
If success(2) > 0 Then 
cov_pen = cov_crit 
Else 

cov_pen = 0 
End If 

If success(l) > 0 Then 
s_pen = success_crit 
cov_pen - cov_crit 
Else 

s_pen = 0 
End If 

calc_fitness = obj(l) + theta_crit * ntheta + omega_crit * nomega _ 
+ sigma_crit * nsigma + cov_pen + corr_pen + s_pen 

Close #1 
End Function 
Private Sub get_files(files) 
files(l) = "nonmem.dir 
files(2) = "freport" 
files(3) = "nonmem.lib" 
fdes(4) = "nonmem.exp" 
files(5) = "FWARN" 
ffles(6) = "PRDERR" 
files(7) - "fsubs M 
files(8) = "fsubs.obj" 
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files(9) = "linkink" 
End Sub 

Private Sub wait(filename As String) 

Dim list As String, flen As Long 
list = Dir(CurDirO & *Y & filename, vbNormal) 
If list <> "" Then flen = FileLen(filename) 
While flen = 0 
DoEvents 

list = Dir(CurDir() & 'Y & filename, vbNormal) 

If list o Then flen = FileLen(filename) 
Wend 
End Sub 

Sub scale_fitness(new - fitness() As Single, temp_fitness() As Single) 

* linearly between mean = 2sd = 0.3 and mean + 2sd = 2 
TMote that a higher obj is a lower fitness 

' first find the geometric mean fitness and subtact all values from that. 
Dim i As Integer, n As Integer 

Dim sd As Single, slope As Single, b As Single, mean As Single 

i - UBound(temp_fitness) 

Dim sumx As Single, sumxx As Single 

' get sd 

Dim fitnessO As Single 

Dim min As Single 5 need minium to assign value when no obj 

Dim max As Single ' 

max = -9999999 

min = 9999999 

ReDim fitness(i) 

For n = 1 To i 

If temp_fitness(n) < min And temp_fttness(n) > -99999999 Then min = temp_fitness(n) 
If temp_fitness(n) > max And temp_fitness(n) < 99999999 Then max = temp_fitness(n) 
fitness(n) = temp_fitness(n) 
Next n 

1 now go through and assign min - (0.1)*(max -min) to the unsucessful 

Dim high As Single 

high = max + 0.1 * (max - min) 

For n = 1 To i 

If fitness(n) > 99999999 Then fitness(n) = high 
Next n 

For n = 1 To i 

sumx = sumx + fitness(n) 

Nextn 

mean = sumx / i 

' now replace fitness with mean - fitness 
surnx = 0 
For n = 1 To i 

fitness(n) = mean - fltness(n) 
Next n 

* now get sd of transformed fitness 
For n = 1 To i 

sumx = sumx + fitness (n) 

sumxx = sumxx + fitness(n) * fitness(n) 

Next n 
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mean = sumx / i 
Ifi> IThen 

sd = Sqr((i * sumxx - (sumx * sumx)) I (i * (i - 1))) 
Else 
sd = 0 
End If 

'now draw line from (mean -2d,lower limit) and (mean + 2sd, upper limit) 
If sd = 0Then 
slope - 0 
Else 

slope = (upper_fitness_limit - lower_fitness_limit) / (4 * sd) 

' y - mx + b 

*b= y- mx 

b = 1 - slope * mean 

End If 

For n = 1 To i 

new„fitness(n) = b + slope * fitness(n) 

If new_fitness(n) < lower_fUness_limit Then new_fitness(n) = lower_fitness_limit 
If new_fitness(n) > upper_fitness_limit Then new_fitness(n) = upper_fitness_limit 



Next n 

'Open "c:\ga\fitness" For Output As #1 
Dim n_pop As Integer 
For n_pop = 1 To i 

Write #1, temp_fitness(n_pop); new_fitness(n_pop) 
Wext n_pop 
Close #1 
End Sub 

Sub select_pairs(pairs() As Integer, cumJitnessQ As Single) 
' select individuals based on fitness, put then into pairs 
Dim rand As Single, i As Integer, p As Integer, n As Integer, n_ind As Integer 
' Open "c:\ga\pairs" For Output As #1 
n_ind = UBound(cum_fitness) / 2 
For i = 1 To 2 
For n = 1 To n_ind 
rand = Rnd() 

P = l 

While rand > cum_fitness(p) 

p = p+l 

Wend 

pairs(i, n) = p 

1 Print #1, rand; cum_fitness(p); p 
Next n 
Next i 
Close #1 
End Sub 

Sub load_data(sheet As vaSpread, dirjname As String) 

frm_graphics.CommonDialogl. filename = dir_name & "V.dat" 

Dim Data() As Single, temp As String, varname As String, tmp_num As Integer 

Dim data_row() As Single, mdv_col As Integer, n_col As Integer 

Dim row_string As String 

Dim this_col As Integer, this_row As Integer 

Dim next_position As Integer, Iast_position As Integer 

frm_graphics.CommonDialogl.DialogTitle = "NONMEM graphics" 
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£rm_graphics.CommonDialogl.Sho\vOpen 

If InStr(l, frm_graphics.CommonDialogl. filename, "*")o0 Then Exit Sub 
If Dir(frm_graphics.ConunonDialogl. filename, vbDirectory) = Then 
MsgBox ("File not found") 
Exit Sub 
End If 

frm_graphics.lst_x_axisxlear 
frm_graphics .lst_y_axis . c lear 
frm_graphics.lst_sort_col. clear 

Open frm_graphics.CommonDialogl. filename For Input As #1 
Tind start of table 

While Left(Trim(temp), 12) o "TABLE NO. 1" 

Line Input #1, temp 

Wend 

frm_graphics.Show 
'read headers 
temp = Input(l, #1) 
frm_graphics.spr_data.row = 0 
'read whole line then search for tokens 
Line Input #1, row_string 
' at least position 1 1 has to be character 
next_position = InStr(l 1, row_string, " ") 
last_position = 1 
* find the mdv column 
Do While next_position o 0 
this_col = this_col + 1 

varname = Mid(row_string, last_position, next_position - last_position) 
* if varname is not alpha, there are no variable names 
If IsError(Val(varname)) Then 

MsgBox ("No variable names, next time please use the ""One Header"" option") 

Exit Do 
End If 

If Trim( varname) = "MDV" Then mdv_col = this_col 

frm_graphics.spr_data.col = this_col 

frm _graphics.spr_data.value = Trim( varname) 

frm_graphics.lst_x_axis.AddItem Trim(varname) 

irm_graphics.lst_y_axis.AddItem Trim( varname) 

frm_graphics.lst_sort_col.AddItem Trim( varname) 
lasLposition = next_position + 1 
' find next space in row 

next_position = InStr(last_position +11, row_string, " ") 
Loop 

' then one more 
this_col = this_col + 1 
If mdv_col = 0 Then 

MsgBox ("No MDV column found, all data will be displayed") 
End If 

varname - Mid(row_string, last_position, Len(row_string) - last_position +1) 
If Trim( varname) = "MDV" Then mdv_col = this_col 
frm_graphics.spr_data.col = this_col 
frm_graphics.spr_data. value = Trim( varname) 
frm_graphics.lst_x_axis.AddItem Trim( varname) 
nrm_graphics.lst_y_axis.AddItemTrim(varname) 
frm_graphics.lst_sort_col.AddItemTrim(vamame) 
n_col = this_col 
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ReDint data„row(l To n_col) 
' read data' 

While EOF(l) = False 
Input #1, row_string 
For this_coI = 1 To n_col 

data_row(this_col) = Val(Mid(row_string, 1 + (this_col - 1) * 12, 12)) 
Next this_col 

If mdv„col <> 0 Then ' can we check if mdv = 1 ? 
If data_row(mdv_col) = 0 Then 
this_row = this_row + 1 
* use data 

frm__graphics.spr_data.row = this__row 
For this_col = 1 To n__col 
frrn_graphics.spr_data.col = this_col 
frm _graphics.spr_data. value = data_row(this„col) 
Next this_col 
End If 
Else 

' use it regardless if mdv not present 
this_row = this_row + 1 
frm_graphics.spr_data.row = this„row 
For this_col = 1 To n_col 
frm_graphics.spr__data.col = this_col 
frm_graphics.spr_data. value = data_row(this_col) 
Next this_col 
End If 
Wend 
Close #1 

frm_graphics.spr_data.MaxRows = this_row 
1rm„graphics_interface.Show 
End Sub 

Sub scan_tokens() 

' look for (), (1-0), unmatched 0, unmatched { }, {(}), ({ }), ({)} 
* only if they occur before a in the token 

Dim short_token As String, token As String, i As Integer, ok As Boolean 

Dim this_token _group As Integer, this_token_set As Integer, this_token As Integer 

Dimposl As Integer, pos2 As Integer 

ok = True 

For this_token_group = 1 To n_token__groups 
For this_token_set = 1 To token_collection(this_token _group).n_token_sets 
For this_token = 1 To token_collection(this_token_group).n_tokens 
token = token_collection(this_token_group).get_token(this__token_set, this_token) 
'first get the part left of 1 ;" 
If InStr(token, ";") = OThen 
short_token = token 
Else 

short_token = Left(token, InStr(L token, ";") - 1) 
End If 

'look for THETA(l-0)x 
For i = 0 To 9 

If InStr(UCase(short_token), "ETA( M & Trim(str(i)) & ")") o 0 Then 
MsgBox ("Number M & str(i) & " in token = " & token & " stem = M & 
token_collection(this_token_group).stem & _ 

w Token set # " & this_token_set & " Token # " & this_token) 
ok = False 
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End If 

If InStr(UCase(short_token), "EPSf & Trim(str(i)) & T) o 0 Then 
MsgBox ("Number " & str(i) & " in token = " & token & " stem = " & 
token_coUection(this_token_group).stern & „ 

" Token set # " & this_token_set & " Token # " & this_token) 
ok = False 
End If 
Next i 

' check for unbalance () have to loop through until all ( are found 
' before next ( 

posl = 1 'position of first ( 
pos2 = 1 ' position of next ( 
While InStr(posl + 1, short^token, "(") <> 0 

posl = InStr(posi + 1, short_token, "(") 

If posl >0 Then 
If InStr(posl, short Jokcn, ")") = 0 Then 

MsgBox ("Unmatched ( in " & token & " stem = " & token_collection(this_token_group).stem & _ 

" Token set # " & this_token_set & ,r Token # " & this_token) 
ok = False 
End If 
End If 
Wend 

Next this _token 
Next this_token_set 
Next this_token _group 
If ok = True Then MsgBox "No errors found" 
End Sub 

Public Function make_int(this_ind As Integer) As Double 

'need to start with binary (genome) not values 

Dim this_digit As Integer, length_genome As Integer, rvai As Double 

length_genome = UBound(genome, 1) 

For this_digit = I To length_genome 

If genome(this_digit, this_ind) = True Then rval = rval + 2 A (this_digit - 1 ) 
Next this_digit 
make_int = rval 
End Function 

Public Sub clear_form(Form As vaSpread) 
Dim this_row As Integer, this_col As Integer 
With Form 

For this_row = 1 To n_runs 
.row - lhis_row 

For this_col = 1 To 8 

.col = this„col 

.text = mt 

Next this_col 
Next this_row 
End With 
End Sub 



Public Sub get_stats(directory As String, obj As Single, fitness As Single, covar As Boolean, success As 
Boolean) 

'read the files parms and return the statistics, send to calc_fitness 
ChDir directory 
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Close #1 

If Dir("PARMS\ vbNormal) o M " Then 
Open "PARMS" For Input As #1 
End If 
Close #1 
End Sub 

Public Function check_token(box As TextBox) As Boolean 

check_token - True 

Dim temp_str As String 

Dim n„parens As Integer 

Dim pos As Integer 

temp_str = box.text 

pos = InStr(l, temp_str, " ") 

While pos o 0 

temp_str = Left(temp_str, pos - 1) & _ 

Rightftemp^str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, " ") 
Wend 

box.text = temp_str 

pos = InStf(l, temp_str, "(") 

While pos <> 0 

n_parens = n_parens + 1 

temp_str = LefXtemp.str, pos - 1) & _ 

Right(temp_su\ Len(temp_str) - pos) 
pos = InStr(l, temp.str, "(") 
Wend 

' now subtract one for each ")" 

pos = InStr(l, temp_str, ")") 

While pos <> 0 

n_parens = n_p areas - 1 

temp_str = Left(temp_str, pos - 1) & _ 

Right(temp_str, Len(temp_str) - pos) 
pos = InStr(L temp_slr, ")") 
Wend 

If n_parens > 0 Then 

MsgBox "Too many »»("- s " 

box.SelStart = InStr(l, box.text, "(") - 1 

box.SelLength = 1 

checkjoken = False 

Exit Function 
End If 

If n_parens < 0 Then 

MsgBox "Too many N ")""s" 

box.SelStart = InStr(l, box.text, ")") - 1 

box.SelLength = 1 

check_token - False 

Exit Function 
End If 

' and now the { } 

temp_str = box.text 

pos = InStr(l, temp_str, " { ") 

While pos o 0 

n_parens = n_parens + 1 

temp_str = Left(temp_str, pos - 1) & _ 

Right(temp_str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, "{") 
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Wend 

' now subtract one for each ")" 

pos = InStrO, temp_str, "}") 

While pos o 0 

n_parens = n_parens - 1 

temp_str = Left(temp_str, pos - 1) & _ 

Right(temp_str, Len(temp_str) - pos) 
pos = InStr(l, temp_str, " }") 
Wend 

If n_parens > 0 Then 

MsgBox "Too many ""{""s" 

box.SelStart = InStr(l, box.text, T) - 1 

box.SelLength = 1 

check_token = False 

Exit Function 
End If 

If n_parens < 0 Then 

MsgBox "Too many " n } ,,,l s n 

box.SelStart = InStr(l, box.text, "}") - 1 

box.SelLength = 1 

check_token = False 

Exit Function 
End If 

End Function 



Public Sub load_results(spread As vaSpread, chart As MSChart) 

'recurse through the directories, calculate the fitness for each run and write to spread sheet 
Dim i As Integer 

Dim n_ind As Integer, this_ind As Integer 

Dim cur_gen_dir As String, cur_ind„dir As String, this_row As Integer 
Dim obj(l To 2) As Single, success(l To 2) As Single, covar As Boolean 
Dim fitness() As Double, scaled Jatness() As Single, temp_fitness() As Single 
Dim n_gen As Integer, max_ind As Integer, max__gen As Integer, max_x As Single 
' how many individuals 

this_gen = 1: this_ind = 1 : max_gen = 0: max_ind = 0 
this_row = 0 

'cur_gen_dir = home_directory & 'V & Trim(str(this_gen)) 
bur Jnd.dir = cur_gen„dir & 1 V & Trim(str(thisjnd)) 
For this__gen = 1 To last_gen 

While Dir(cur_gen_dir, vbDirectory) = Trim(str(this_gen)) 

' If this_gen > max_gen Then max_gen = this_gen 

' While Dir(cur_ind„dir, vbDirectory) = Trim(str(this„ind)) 

1 If this_ind > max_ind Then max_ind = this_ind 

' this_ind = this_ind + 1 

* cur_ind_dir = cur_gen_dir & "V & Trim(str(this_ind)) 

* Wend 'cur_Jnd_dir 
this_ind = 1 

*cur_gen_dir = home_directory & "V & Trim(str(this_gen)) 

Next this_gen 

*this_gen - last_gen 

Wend ' cur_gen_dir 

ReDim fitness(l To pop_size) 

ReDim scaled Jitness(l To pop_size): ReDim temp_fitness(l To pop__size) 

* initialize plot axis for generations 
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frra_main.spr_result.MaxRows = pop_size * generationjimit 
max_x = generationjimit 
initialize_plot generationjimit 
this_gen = 1: tMs_ind = 1 
For this__gen = 1 To last_gen 

cur_gen_dir = home„directory & T & Trim(str(this_gen)) 
While Dir(cur„gen_dir, vbDirectory) = Trim(str(this_gen)) 
'While Dir(cur_ind_dir, vbDirectory) = Trim(str(this_ind)) 
For this_ind = 1 To pop_size 

cur_Jnd_dir = cur_gen_dir & "V & Trim(str(this Jnd)) 
' we need obj success, covar } fitness, boundary for theta. 

* the calc scaled fitness 

* read input, parms 

read_results cur_ind_dir, obj, success, covar, fitness(this_ind) 
this_row = this_row + 1 
With frm_main.spr_result 

.row = this_row 

.col = 1: .text= obj(l) 

.col = 2: If success(l) = 0 Then .text = "Yes" Else .text = "No" 
.col = 3: If success(2) = 0 Then .text = "Yes" Else .text = "No 11 
.col = 4: .text- fitness(this_ind) 
.col - 8: .text = this_gen 
.col = 9: .text = this_ind 
End With 

temp_fitness(this„ind) = fitness(this_ind) 

* this_ind = this_ind + i 

' cur_ind_dir = cur_gen_dir & 'V & Trim(str(this_ind)) 
Next this_ind ' end of individual while 

scalejitness scaied_fitness(), temp_fitness() 

* update plot 

update__plot temp_fitness(), scaled_fitnessO 
1 tliis_gen = this_gen + 1 

' cur_gen_dir = home_directory & "\" & Trim(str(this„gen)) 
! this_ind - 1 

* cur_ind_dir = cur_gen_dir & "\" & Trim(str(this_jnd)) 
Next this_gen 

run_number = last_gen * pop_size 
frm_main.pgb_gen - last„gen 
frm_main.pgb_gen.max = generation_Iimit 
firm_main.pgb__ind.max = pop_size 

frm_main.pgb_ind - 1 

Wend * end of generation while 
MsgBox frm_main.spr_result.MaxRovvs 
End Sub 



Sub read_results(this_dir As String, ByRef obj() As Single, ByRef success() As Single, covar As Boolean, 
fitness As Double) 

Dim theta(l To max_theta) As Single, setheta(l To max_theta) As Single 

Dim ntheta As Integer, nomega As Integer, nsigma As Integer, ntheta_jixed As Integer, nomega_fixed As 
Integer, nsigmajfrxed As Integer 

Dim Iltheta(l To max_theta) As Single, ultheta(l To max_theta) As Single 
Dim omega(l To 30, 1 To 30) As Single, seomega(l To 30, 1 To 30) As Single 
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Dim sigma(l To 30, 1 To 30) As Single, sesigma(l To 30, 1 To 30) As Single 

Dim rm(l To 69, I To 69) As Single 

Dim i As Integer, temp As String, n As Integer 

success(l) = 999 
success(2) = 999 
ChDir this_dir 
'read from inputs 

If Dir("inputs", vbNormal) <> " M Then 
Open "inputs" For Input As #1 
Line Input #1, temp 

Input #1, ntheta, nomega, nsigma, ntheta_fixed, nomega_fixed, nsigmajfrxed 
Close #1 
End If 

If DirCparms", vbNormal) o Then 

' need to read in obj, success, covar,setheta, seomega 

Open this_dir & "V & "panns" For Input As #1 

temp = Input(4,#l) 

Input #I,obj(l) 

temp = Input(9,#l) 

Input #1, success(l), success(2) 

For i = 1 To 6 

Line Input #1, temp 

Next i 

For i = 1 To ntheta 

Input #1, litheta(i), ultheta(i) 

Next i 

Line Input #1, temp 
For i = 1 To ntheta 
Input #1, theta(i) 
Next i 

Line Input #1, temp 
For i = 1 To nomega 

For n = 1 To nomega 

Input #1, omega(i, n) 

Next n 

temp = Input(2, #1) ' crlf 
Next i 

Line Input #1, temp 
For i = 1 To nsigma 

For n = 1 To nsigma 

Input #1, sigma(i, n) 

Next n 

• If Not (EOF(I )) Then Input #1, temp 
Nexti 

'only read se's and rm if successfuil 

If success(2) = 0 Then 
5 read rm and se here 
End If 
Close #1 

fitness = calc_fitness(obj(), successO, setheta(), seomegaO, sesigma(), rm(), _ 
theta_crit, omega_crit, sigma_crit, cov_crit, ntheta) 



Else 
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Exit Sub 
End If 
Close 1 
End Sub 



Function count_max_omega() As Integer 
' go to the tokens and find how many unique omegas are there. 
5 count the number of unique ETA(??) where ?? is A - AZ 
Dim used„eta(l To 52) As Boolean 

Dim this_eta As Integer, token_string As String, check_string As String 
Dim this_token _group As Integer, this_token_set 
Dim n_omega As Integer, n_token_sets As Integer 
Dim this_token As Integer, n_tokens As Integer 
Dim test_string As String, n_sets As Integer 

Dim controLstring As String, n_token_omegas ' number of omegas in tokens (ie„ "A") 
control_string = UCase(frm_main.txt_code) 

* well assume there are less than 10 omegas in the control file and less than 27 on the token sets 
test_string = "ETA(" & Trim(Chr(49)) & 

* change all the THETAs to xxx 

controLstring = sub_string(controLstring, "THETA", "XXXXX") 
While InStr(l, controLstring, test_string) <> 0 And n_omega < 10 
n_omega = n_omega + 1 

test_string = "ETA(" * Trim(Chr(49 + n_omega)) & ")" 
Wend 

For this_token_group = 1 To n_token_groups 
n_token„sets = token_collection(this_token_group).n_token„sets 
For this_token_set = 1 To n_token_sets 

' loop through set to see if it is used 

n_tokens = token_collection(this_token_group).n_tokens 

For this_token = 1 To n_tokens 
token_string - token_string & vbCrLf & token_collection(this_token_group).get_token(this_token_set, 

this_token) 

Next this_token 
Next this_token_set 
Next this_token_group 

* get rid of THETA (to XXXX) 

token_string = sub_string(token_string, "THETA", "XXXXX") 
'frm_text.txt_text = token_string 
'frm_text.Show 1, frm__main 
test_string = M {ETA( ,( & Trim(Chr(65)) & ")}" 
While InStr(l, token_string, test_string) <> 0 
n_token_omegas = n_token_omegas + 1 

tesLstring = "{ETA( H & Trim(Chr(64 + n_token_omegas)) & ")}" 
Wend 

count_max_omega = n_omega + n_token_omegas 
End Function 

Function count_etan(control As String) As Integer 
Dim controLstring As String, test_string As String 
Dim test_n As Integer 
controLstring = UCase(control) 

* well assume there are less than 10 omegas in the control file and less than 27 on the token sets 
test_n = 1 

test.string = "ETA(" & Trim(str(test_n)) & ")" 
'change all the THETAs to xxx 
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controLstring = sub_string(controLstring, "THETA", "XXXXX") 
While InStr(l , controLstring, test_string) <> 0 And n_omega < 10 
test_n = test_n + 1 

test_string = "ETA(" & Trim(str(test_n)) & ")" 
Wend 

counLetan = test„n - 1 
End Function 
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File token_group.cls 

VERSION 1.0 CLASS 
BEGIN 

MultiUse = -1 'True 
END 

Attribute VB_Name = " token_group" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB__Exposed = False 

Attribute VB_Ext_KEY = " SavedWithClassBuilder " , "Yes" 
Attribute VB_Ext_KEY = "Top^Level" , "Yes" 
'local variable (s) to hold property value (s) 
Private local_stem As String ' local copy 

Private local_n_tokens As Integer ' number of tokens in set , e.g., 

theta(next) , (0, 1, 100) = 2 tokens 

Private local_n_token_sets As Integer 

Private token_sets(l To 50, 1 To 10) As String 

Option Explicit 

Public Sub remove_token_set (ByVal position As Integer) 
Dim row As Integer, col As Integer 
For row = position To local_n_token_sets - 1 
For col = 1 To n_tokens 

token_sets (row, col) = token_sets (row + 1, col) 
Next col 
Next row 

local_n_token_sets = local_n_token_sets - 1 
End Sub 

'Private all_sets As Collection 

Public Sub add_token_set (lst_sets As ListBox) 

local„n_token_sets = local_n_token_sets + 1 

ge t„t oken_set 1 s t_s e t s 

End Sub 

Public Property Get stem() As String 

stem = local_stem 
End Property 

Public Property Let stem(ByVal lstem As String) 

local_stem - lstem 
End Property 

Public Property Get n„tokens ( ) As Integer 

n_tokens - 1 oca l„n_ tokens 
End Property 

Public Property Get n_token_sets ( ) As Integer 

n_token_sets = local_n_token_sets 
End Property 

Public Property Let n_tokens(n As Integer) 

local_n_tokens = n 
End Property 

Public Sub get_token_set (this_list As ListBox) 
Dim i As Integer, n As Integer 



Replacement Sheet 

09/878,686 
Group Art Unit 2123 

FIG. 8A-50 

Dim tok_str As String 
this_list . clear 

For i = 1 To local_n_token_.se ts 
tok_str - i & n 

For n = 1 To local__n_tokens 

tok_str = tok_str & " { " & token_sets (i , n) & n ) " 
Next n 

this_list .Addltem tok_str 
Next 

End Sub 

Public Sub get_tokens ( this_list As ListBox, this_token_set As Integer) 

Dim i As Integer 

this_list .clear 

If this_token_set <> 0 Then 

For i = 1 To local_n_tokens 

this_list .Addltem " ( " & token_sets ( this_token_set , i) & ") " 
Next i 
End If 
End Sub 

Public Sub get_tokens_lines { this_list As ListBox, this_token_set As 
Integer) 

Dim i As Integer 
Dim str As String 

Dim start As Integer, last As Integer 

this_list . clear 

For i = 1 To local_n_tokens 

str = token_sets ( this__token„set , i) 

While InStrd, str, n {crlf}°) <> 0 

start = InStrd, str, "{crlf}") 

last = Len(str) - InStr(l, str, " {crlf } " ) + Len ( " {crlf } " ) 
str - Trim(Lef t (str, start) & vbCrLf & _ 
Trim (Right (str , last) ) ) 

Wend 

this_list .Addltem " { " & str & ") " 
Next i 
End Sub 

Public Function get_token (ByVal set_nuin As Integer, ByVal token_num As 
Integer) As String 

get_token = token_sets (set_num, token_num) 
End Function 

Public Function get_token_with„lines (ByVal set_num As Integer, ByVal 
token_num As Integer) As String 
Dim str As String 

Dim start As Integer, last As Integer 
str = token_sets (set_num, token_num) 
While InStrd, str, "{crlf}") <> 0 
start = InStr(l, str, "{crlf}") - 1 

last = Len(str) - InStrd, str, "{crlf}") - Len { n {crlf } " ) + 1 
str ~ Trim(Left (str , start) & vbCrLf & _ 
Trim (Right (str, last) ) ) 

Wend 

get_token_with_lines = str 
End Function 
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Public Sub set_token(ByVal set_num As Integer, ByVal token_num As 
Integer, value As String) 

' we need to replace crlf by another character - {crlf} 
Dim start As Integer, last As Integer 
While InStr(l, value, vbCrLf) <> 0 
start = InStrd, value, vbCrLf) - 1 
last = Len (value) - start - 2 

value = Trim (Left (value, start)) & "{crlf}" & _ 
Trim (Right (value, last) ) 

Wend 

token_sets (set_num, token_num) = value 
End Sub 

Public Sub clear ( ) 

Dim i As Integer, n As Integer 

For i = 1 To n_token_sets 

For n = 1 To n_tokens 

token_set s ( i , n ) = " n 

Next n 
Next i 

local_n_token_sets = 0 
local_n_tokens = 0 
local_stem = " " 
End Sub 
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File frm_main.frm 

VERSION 5.00 

Object = It {B02F3647-766B-llCE-AF28-C3A2FBE76A13}#2.5#0" ; " SS32X25 .OCX" 
Object = " {02B5E320-7292-llCF-93D5-0020AF99504A}#1.0#0"; "MSCHART . OCX " 
Object = " {BDC217C8-ED16-11CD-956C-OOOOC04E4COA}#1.1#0" ; " TABCTL3 2 . OCX 
Object = " {6B7E6392-850A-101B-AFCO-4210102A8DA7}#1.2#0"; " COMCTL3 2 . OCX 
Object = " {F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0" ; n Comdlg32 . ocx 
Begin VB.Form frm__main 

Caption = "NOlSfMEM GA " 

ClientHeight = 9120 

ClientLeft = 2310 

ClientTop = 1815 

ClientWidth = 12825 

Icon = " f rm__main. f rx" : 0000 

LinkTopic = "Forml" 

ScaleHeight = 9120 

ScaleWidth = 1282 5 

Begin MSCornDlg.CommoriDialog CoramonDialogl 
Left = 240 

Top = 6000 

_ExtentX = 847 

_ExtentY = 847 

_Version = 327680 

End 

Begin VB. Frame Frarael 

Height = 615 

Left = 7920 

Tab Index = 9 

Top = 8400 

Width = 2055 

Begin VB . OptionButton Opt_resume 

Caption = "Resume" 

Enabled = 0 'False 

Height = 255 

Left = 960 

Tablndex = 11 

Top = 240 

Value - -1 'True 

Width = 975 

End 

Begin VB . OptionButton opt__pause 
Caption = "Pause" 

Height = 255 

Left = 120 

Tablndex - 10 

Top = 240 

Width = 1215 

End 

End 

Begin VB . CommandButton but_stop_run 
Caption = "Stop Run" 

Height = 375 

Left = 6840 

Tablndex = 3 

Top = 8520 
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Width = 855 

End 

Begin TabDlg.SSTab SSTabl 
Height = 8295 

Left = 360 

Tablndex - 0 

Top = 0 

Width = 12255 

_ExtentX = 21616 

_ExtentY = 14631 

„Version = 393216 

TabOrientation = 3 
Tab = 2 

TabHeight = 520 

BeginProperty Font { OBE35203-8F91-11CE-9DE3-OOAA004B3851} 

Name - "Arial" 

Size = 11.25 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 

TabCaption(O) = "Control" 
TabPicture(O) = " f rm_main . f rx" : 0442 
Tab(0) .ControlEnabled= 0 'False 
Tab ( 0 ) . Control ( 0 ) = " txt_code " 
Tab{0) .ControlCount= 1 
TabCaption(l) = "Result Plot" 
TabPicture (1) = "f rm_main. frx" : 045E 
Tab(l) .ControlEnabled= 0 'False 
Tab(l) .Control (0)= "MSChartl" 
Tab{l) .ControlCount= 1 
TabCaption{2> = "Results table" 
TabPicture (2) = ■ f rm_main. f rx n : 047A 
Tab(2) .ControlEnabled= -1 'True 
Tab (2) .Control (0)= " spr__result " 
Tab(2) .Control (0) .Enabled= 0 'False 
Tab (2) .ControlCount- 1 
Begin VB.TextBox txt_code 

Height = 7815 

Left = -74160 

MultiLine = -1 'True 

ScrollBars = 2 'Vertical 

Tablndex = 7 

Top = 240 

Width = 9495 

End 

Begin MSChartLib .MSChart MSChartl 

Height = 7815 

Left = -74880 

OleObjectBlob = n frm_raain . frx" : 049 6 

Tablndex = 1 

Top = 120 

Width = 10815 

End 

Begin FPSpread. vaSpread spr_result 
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Height = 
Left 

Tab Index = 

Top 

Width 

^Version = 

_ExtentX 

_ExtentY 

_StockProps = 
BeginProperty Font 

Name 

Size 

Chars et 

Weight 

Underline 

Italic 

Strike through 
EndProperty 
MaxCols = 
ScrollBars = 
ScrollBarShowMax= 
SpreadDe signer = 
UserResize = 
VisibleCols = 
VisibleRows = 



7935 

240 

8 

120 

11115 

131077 

19606 

13996 

64 

{0BE35203-8F91-11CE- 
"MS Sans Serif" 
8.25 



9DE3-OOAA004BB851} 



0 

700 
0 
0 
0 



'False 
'False 
' False 



11 
2 

0 'False 

w frm_main.frx n :252A 

2 

500 
500 



End 



End 

Begin Comet ILib . ProgressBar pgb_ind 



Height 
Left 

Tablndex 

Top 

Width 

_ExtentX 

_ExtentY 

_Version 

Appearance 



210 

1440 

2 

8400 
5175 
9128 
370 

327682 
1 



End 

Begin Come tlLib. ProgressBar pgb_gen 
Height 
Left 

Tablndex = 
Top 
Width 
_ExtentX 
_ExtentY 

_Version = 
Appearance = 
End 

Begin VB. Label Label3 
Caption - 
Height = 
Left 

Tablndex = 
Top = 
Width 

End 



210 

1440 

4 

8760 
5175 
9128 
370 

327682 
1 



"Unicfue models" 
255 
10080 
13 

8640 
1335 
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Begin VB. Label lbl_count 
BackColor = 
BorderStyle = 
Caption = 
Height 
Left 

Tab Index = 
Top = 
Width 
End 

Begin VB. Label Labell 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB. Label Label2 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 

End 

Begin VB.Menu file 
Caption = 
WindowList = 
Begin VB.Menu new 

Caption = 

End 

Begin VB.Menu open 
Caption = 

End 

Begin VB.Menu Save 
Caption = 

End 

Begin VB.Menu Load 
Caption - 

End 

Begin VB.Menu save_as 
Caption = 

End 

Begin VB.Menu Exit 
Caption = 

End 

Begin VB.Menu break 
Caption = 

End 

Begin VB.Menu files 
Caption = 
Index - 
Visible 

End 

Begin VB.Menu files 
Caption = 



&H80000009& 
1 'Fixed Single 
"0 n 
375 
11640 
12 

8520 
855 



"Individuals* 
255 
360 
6 

8400 
975 



"Generations" 
255 
360 
5 

8760 
1095 



"File" 
-1 'True 



" &New n 



tt &0pen" 



•ScSave" 



"Load results' 



'S&ave As" 



" E&xit" 



'Files" 



' False 



"Files" 
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Index = 2 

Visible = 0 'False 

End 

Begin VB.Menu files 

Caption = "Files" 

Index = 3 

Visible = 0 'False 

End 

Begin VB.Menu files 

Caption = "Files" 

Index = 4 

Visible = 0 'False 

End 

End 

Begin VB.Menu edit 

Caption = n Edit" 

Begin VB.Menu Edi t_token_set 

Caption = "Edit Token Set" 

End 

Begin VB.Menu sort 

Caption = "Sort Results" 

End 

Begin VB.Menu print 

Caption = "Print" 

End 

Begin VB.Menu copy 

Caption = "Copy" 

End 

End 

Begin VB.Menu Run 

Caption = "Run" 

Begin VB.Menu check_out 

Caption = "Check Out" 

End 

Begin VB.Menu ga_Run 

Caption = " GA Run" 

End 

Begin VB.Menu continue_run 

Caption = "Continue GA run" 

End 

Begin VB.Menu full_grid 

Caption = "Full Grid Search" 

End 

Begin VB.Menu debug 

Caption = "Debug" 

End 

End 

Begin VB.Menu option 

Caption = "Options" 

Begin VB.Menu settings 

Caption = "Settings" 

End 

End 

Begin VB.Menu help 

Caption = "Help" 

End 

End 
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Attribute VB_Name = M frm_main n 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute. VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Private cur_model_f ile_narae As String 

Private file_name As String ' just the file name without the path 
Option Explicit 

Private Sub but_stop_run — Click ( ) 
stop_run = True 
End Sub 

Private Sub copy_Click() 
If SSTabl.Tab = 1 Then 
MSChartl . EditCopy 

MsgBox "result plot chart copied to clipboard" 
End If 

If SSTabl.Tab = 2 Then 
spr_result .col = -1 
spr_result .row = -1 
spr_result .Action = 22 
End If 
End Sub 

Private Sub debug_ClickO 
f rm — debug . Show 1, Me 
End Sub 



Private Sub files_Click( Index As Integer) 

cur_model_f ile_name = start__files ( Index) 
get__model cur_model„f ile_name 
Dim pos As Integer 
pos = 1 

While InStr(pos + 1, cur_model_f ile_name, " \ " ) > 0 
pos = InStr(pos + 1, cur_model_f ile_name, " \ " ) 
Wend 

home_directory = Lef t (cur_model_f ile_name, pos - 1) 
ChDir (home__di rectory) 

file_name = Right (cur_raodel_f ile_name, Len (cur_model_f ile_name) - pos) 
home_drive = Lef t (home_di rectory, 2) 
ChDr i ve { home_dr i ve ) 
End Sub 

Private Sub FormJUnload (Cancel As Integer) 
End 

End Sub 

Private Sub Load_Click ( ) 

If MsgBox( "Load results from " & home_directory & " ? n , vbOKCancel) <> 
vbOK Then Exit Sub 

loader esults frm__main. spr_result , frm_ma in. MSChartl 



End Sub 
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Private Sub opt_pause_Click( ) 
op t_^>ause. Enabled = False • 
paused = True 
Opt_resume . Enabled = True 
End Sub 

Private Sub op t_pause_Dbl Click ( ) 

opt_pause. Enabled = False 

paused = True 

Op t_resume .Enabled = True 

End Sub 

Private Sub Opt_resume_Click ( ) 
Opt_resume . Enabled = False 
paused = False 
op t_pause. Enabled = True 
End Sub 

Private Sub Opt_resume_DblClick ( ) 
Op t_r e sume . Enabled = False 
paused = False 
opt_pause . Enabled = True 
End Sub 

Private Sub print_click ( ) 
If SSTabl.Tab = 1 Then 
End If 

If SSTabl.Tab = 2 Then 
spr_result . col = -1 
spr_result .row = -1 
spr_result .Action = 22 
End If 

End Sub 

Private Sub New_Click() 
Me . txt_code . text = " " 
se t_de f aul t_opt i ons 
End Sub 

Private Sub set_def ault„options ( ) 
End Sub 



Private Sub sort_Click() 
f rm_sort„results . Show 
End Sub 

Private Sub spr_result_Click(ByVal col As Long, ByVal row As Long) 
Dim gen As Integer, ind As Integer 
Dim text As String, textline As String 
Dim file_name As String 
Select Case col 
Case 5 

spr_result . col = 8 
spr_result .row = row 
If spr„result .value = " " Then 
MscrBox "No results available" 
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Exit Sub 
End If 

If save_output = False Then 

MsgBox "Output file not saved, see options" 
Exit Sub 
End If 

gen = spr_result .value 

spr_result . col = 9 

ind = spr_result. value 

If spr_result .value = " " Then 

MsgBox "No results available" 

Exit Sub 

End If 

file_name = home„di rectory & "\ n & gen & " \ " & ind & "\output" 
If Dir (file_name, vbNormal) = " " Then 
MsgBox "Output file not found" 
Exit Sub 
End If 



Open file_name For Input As #1 

Do While Not EOF(l) ' Loop until end of file. 

Line Input #1, textline ' Read line into variable, 
text = text & textline & vbCrLf 

Loop 

frm_text .Caption = "Output file" 
f rm_text . txt_text = text 
Me. Hide 
f rm_text . Show 
Close #1 ' Close file. 
Case 6 

spr_result . col = 8 

spr_result . row = row 

If spr_result .value = " " Then 

MsgBox "No results available" 

Exit Sub 

End If 

If save_control = False Then 

MsgBox "control file not saved, see options" 

Exit Sub 

End If 

gen = spr_result . value 

spr_result .col = 9 

If spr_result .value = Then 

MsgBox "No results available" 

Exit Sub 

End If 

ind = spr_result. value 

file.name = home_directory & " \ " & gen & "V & ind & "\control" 

Open file_narae For Input As #1 

Do While Not EOF(l) ' Loop until end of file. 

Line Input #1, textline ' Read line into variable. 

text = text & textline & vbCrLf 

Loop 

frm_text .Caption = "Control file" 
friEL.text.txt_.text - text 
f rm_t ex t . Show 1 , f rm_ma in 
Close #1 ' Close file. 
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Case 7 

spr_result .col = 8 

spr_ result .row = row 

If spr_result .value = " " Then 

MsgBox "Generation not available" 

Exit Sub 

End If 

gen = spr_result .value 
spr_result .col = 9 
ind = spr_result .value 

file_name = home_di rectory & "\" & gen & 11 \" & ind 
load_data f rm_graphics . spr_data, file_name 

f rm_graphics . Show 
End Select 
End Sub 



Private Sub check_out_Click( ) 
Dim n__runs As Integer 

n_runs = f rm__options . txt_pop_size * f rm_ppt ions . txt_gener at ions 
f rm_main . spr__resu 1 1 . MaxRows = n_runs 
SSTabl.Tab = 2 
stop_run = False 

frm_main.but_stop_run. Enabled = True 
ga__runner True, True 

frm__main.but_stop_run. Enabled = False 
End Sub 

Private Sub con tinue_run__C lick ( ) 
stop_run = False 
ga_runner False, False 
End Sub 

Private Sub Edit_token_set_Click { ) 
Me. Hide 

frm_ tokens . Show 
End Sub 

Private Sub exit_Click() 
Dim i As Integer 

SaveSetting appname : = " NM_GA " , section: = "Startup" , _ 

Key :="N" , setting: =n_files 
For i = 1 To n_files 

SaveSetting appname : = "NM_GA" , section: = "Startup" , _ 

Key: ="File" & str(i), setting: =start_files (i) 

Next i 

'SaveSetting appname : = " NM_GA " , section: - "Star tup" , _ 

Key:= B File B & str(l) r setting: = "c : \570\amy\ga\570b .mdl " 

'SaveSetting appname : = " NM_GA " , section: = "Startup" , _ 

Key:="File" &str(2) / setting: ="c : \570\amy\ga\ 57 0c .mdl" 

End 

End Sub 

Private Sub Form_Load() 



Replacement Sheet 

09/878,686 
Group Art Unit 2123 

FIG. 8A-61 

'ChDir °c:\ga\" 

'cur_rnodel_file_name = " c : \ga\gen.mdl" 
' get_model cur_model_f ile_name 
'f:rm_tokens.lst_token_group. Listlndex = 0 
' f rm_tokens . lst_ token_sets . Listlndex = 0 

End Sub 

Private Sub full_grid_Click( ) 
stop_run = False 
grid_search 
End Sub 

Private Sub ga_Run_Click ( ) 
Dim n_runs As Integer 

n_runs = f rm_options . txt__pop_size * frm_opt ions . txt_generat ions 
f rrn__main. spr__result .MaxRows = n_runs 
SSTabl.Tab = 2 
stop_run - False 

frm„main.but_stop__run. Enabled = True 
ga_runner True, False 

frm_jnain.but_stop__run. Enabled - False 
' frm_inter„_results .Hide 

End Sub 

Private Sub open_Click() 

Me. CommonDialogl .DialogTitle - "Open GA model" 
ChDir (home_di rectory) 

Me. CommonDialogl. InitDir = home_di rectory 
Me . CommonDialogl . filename = " * .mdl " 
Me . CommonDialogl . ShowOpen 

If Me. CommonDialogl . filename = " *.dat" Or Me .CommonDialogl . filename = 
" " Or Me . CommonDialogl . filename = " * .mdl " Then 
Exit Sub 
End If 

cur_model_f ile_name = Me . CommonDialogl . filename 

get_model Me . CommonDialogl . filename 

frm_tokens . Is t__token_group. List Index = 0 

f rm_tokens . Is t_token_sets . Listlndex = 0 

' get home directory name 

Dim pos As Integer 

pos = 1 

While InStr(pos + 1, cur_model_f ile_name, "\") > 0 
pos = InStr(pos + 1, cur_model_f ile_name, "\") 
Wend 

home_di rectory = Lef t (cur_irtodel_f ile„name, pos - 1) 

file_name = Right (curjmodelj ilejoame, Len { cur_model_f ile_name) - pos) 

ChDir (home_di rectory) 

home_drive = Lef t (home_di rectory, 2) 

ChDr i ve ( home_dr i ve ) 



End Sub 

Private Sub save__as__Click ( ) 
Dim file_name As String 

Me. CommonDialogl .DialogTitle = "Save GA model file" 
Me. CommonDialogl. InitDir = home_directory 
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Me. CommonDialogl. Filter = "*.mdl n 

Me. CommonDialogl . filename = "*.mdl" 

Me .CommonDialogl . ShowSave 

file_name = Me .CommonDialogl . filename 

If Trim(f ile_name) = Then Exit Sub 

If file_name = " " Then 

Exit Sub 

Else 

' set home directory 
Dim pos As Integer 
pos = 1 

While InStr(pos + 1, file_name, "\") > 0 
pos = InStr(pos + 1, file_name, "\") 
Wend 

home_directory = Lef t ( f ile_name, pos - 1) 
ChDir (home_directory) 
home_drive = Lef t (home_directory , 2) 
ChDr i ve ( home__dr ive ) 

file_name = Right { file„name, Len ( f ile_name) - pos) 

ChDr ive ( home_dr ive ) 

cur_model_f ile_name = file_name 

save_model ( f i le_name ) 

Dim i As Integer, n As Integer 

For i = 1 To n_files 

If start_f iles (i) = home_drive & "\ n & home_directory & " V & 
file_name Then 
' remove it 

For n = i To n_files - 1 Step 1 

start_files (n) = start_f iles (n + 1) 
Next n 
n_files = n_files - 1 

start_f iles (n_f iles + 1) = 
Exit For 
End If 
Next i 

If n_files < 4 Then n_files = n_files + 1 
For i = n_files To 2 Step -1 
start_f iles (i) = start_f iles ( i - 1) 
frm_main. files (i) .Caption = start_f iles ( i ) 
Next i 

start_files (1) = home_drive & "V & home_di rectory & M \" & file_name 
frnumain. files (1) .Caption = start_f iles { 1) 
End If 
End Sub 

Private Sub Save_Click{) 
save_model ( f ile_name ) 
End Sub 

Private Sub settings_Click ( ) 

Me. Hide 

set_options 

f rm_options . Show 1 , Me 
End Sub 

Private Sub SSTabl_Click (PreviousTab As Integer) 



If SSTabl.Tab 
sort. Enabled = 
Else 

sort. Enabled = 
End If 
End Sub 
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; 2 Then 
True 

False 
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File frm„debug.frm 



VERSION 5.00 
Begin VB.Form frm_debug 



"Debug 

4080 

60 

345 

5760 

" Forml " 

4080 

5760 



Options " 



'Windows Default 
but_check_unmatched 
"Check for unmatched tokens" 
495 
360 
5 

1200 
2535 



Caption - 
ClientHeight 
ClientLeft = 
ClientTop 
ClientWidth 
LinkTopic = 
ScaleHeight = 
ScaleWidth 

StartUpPosition = 3 
Begin VB.CommandButton 

Caption = 

Height 

Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Frame Framel 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 

Begin VB.CheckBox 
Caption 
Height 
Left 

Tablndex 
Top 
Width 
End 

Begin VB.CheckBox 
Caption 
Height 
Left 

Tablndex 
Top 
Width 
End 

End 

Begin VB.CommandButton but_scan_numbs 



" Break" 
1215 
3240 
2 

480 
1815 

c hk_debug_c on t r o 1 

"Control files" 
255 
120 
4 

720 
1575 



chk„ 



debug__tokens 
" Tokens " 
255 
120 
3 

360 
1575 



Caption 

Height 

Left 

Tablndex = 
Top 
Width 
End 

Begin VB.CommandButton 
Caption = 
Height 
Left 



" Scan 
495 
360 
1 

360 
2535 



Commandl 
" Done " 
495 
2280 



for numbers' 
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Tablndex 

Top 

Width 



0 

3240 
975 



End 

End 

Attribute VBJSfame = "frm_debug n 
Attribute VB_GlobalNameSpace = False 
Attribute VB__Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private Sub but_scan_numbs_Click ( ) 

scan_tokens 

End Sub 

Private Sub Command 1_C lick ( ) 
Me . Hide 
End Sub 
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Filefrm edit_token.frm 



VERSION 5.00 

Object = n {F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0 N ; "Comdlg32 . ocx" 
Begin VB.Form f rm„edit_token 

"Edit Token 0 



Caption 
ClientHeight 
ClientLef t 
ClientTop 
ClientWidth 
LinkTopic 
ScaleHeight 
ScaleWidth 



5355 

3900 

3645 

7065 

"Forml " 

5355 

7065 



Begin MSComDlg. CommonDialog CoramonDialogl 



Left 
Top 

_ExtentX 
_ExtentY 
Version 



480 
4680 
847 
847 

327680 



End 

Begin VB.TextBox txt_token 
BeginProperty Font 
Name = 
Size = 
Char set - 
Weight - 
Underline = 
Italic = 0 

Strikethrough = 0 
EndProperty 

Height = 3615 

HideSelection = 0 
Left = 960 

MultiLine = -1 1 

ScrollBars = 2 

Tablndex = 2 

Top = 480 

Width = 5655 

End 

Begin VB .CommandButton but_cancel 



"MS Sans Serif" 
12 
0 

400 

0 'False 
' False 
' False 



'False 

' True 
Vertical 



Caption 

Height 

Left 

Tablndex 

Top 

Width 



"Cancel' 
495 
4200 
1 

4320 
1095 



End 

Begin VB . CommandButton but_done 

Caption = "Done" 

Height = 495 

Left = 2040 

Tablndex = 0 

Top = 4320 

Width = 1095 

End 

Begin VB. Label Labell 

Caption = "Token" 
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Height 
Left 

Tablndex 

Top 

Width 



375 
120 
3 



960 
855 



End 

Begin VB.Menu file 



Caption = 
Begin VB.Menu import 



"File" 



Caption = 

End 

Begin VB.Menu export 



" Import 



ti 



Caption 

End 

Begin VB.Menu save 



n 



Export " 



Caption 

End 

Begin VB.Menu exit 



ti 



Save and close" 



Caption 

End 



n 



Exit {don't save) 



V 



End 

End 

Attribute VBJSTame = n f rm_edit_token" 
Attribute VB„Global Name Space = False 
Attribute VB__Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 

Private Sub but_done_Click ( ) 

If check_token(txt_token) = False Then 

Exit Sub 

End If 

Me . Hide 

f rm_tokens . Show 
End Sub 

Private Sub iraport„Click ( ) 

Dim code As String, text line As String 

Me. CommonDialogl. DialogTitle = "Import token" 

Me. CommonDialogl . filename = " *.txt" 

Me . CommonDialogl . ShowOpen 

If Me. CommonDialogl. filename = "*.txt" Or _ 

Me. CommonDialogl. filename = " " Then 

Exit Sub 
End If 

Open Me. CommonDialogl . filename For Input As #1 
Do While Not EOF(l) ' Loop until end of file. 

Line Input #1, textline ' Read line into variable. 
Debug. Print textline ' Print to Debug window, 
code = code & textline & vbCrLf 

Loop 

Close #1 

Me.txt_token = code 
End Sub 



Private Sub exoort Click () 
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Dim code As String, textline As String 
Dim new_code As String 

Me.CommonDialogl.DialogTitle = "Export token" 
Me. CornmonDialogl . filename = "*.txt" 
Me .CommonDialogl . ShowSave 

If Me. CommonDialogl. filename = "*.txt" Or _ 
Me. CommonDialogl. filename = n " Then 
Exit Sub 

End If 

Open Me . CommonDialogl . filename For Output As #1 

code = Me . txt_token 
Print #1, code ' Print text to file. 
Close #1 
End Sub 
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File frm^graphics.frm 



VERSION 5. 
Object = 1 
Object = ' 
Object = ' 
Object = ' 



00 

{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0" 
{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1 .1#0" 
{827E9F53-96A4-11CF-823E-000021570103}#1.0#0" 
{F9043C88-F6F2-101A~A3C9-08002B2F49FB}#1 .1#0" 



"SS32X25.0CX" 
"TABCTL32 .OCX" 
"GRAPHS32 . OCX" 
"Comdlg3 2 .ocx" 



Begin VB.Form frm^graphics 



Caption 
ClientHeight 
ClientLef t 
Client Top 
ClientWidth 
LinkTopic 
ScaleHeight 
ScaleWidth 



"Graphics " 

8835 

60 

630 

10695 

" Forml " 

8835 

10695 



Begin MSComDlg.CommonDialog 
Left = 3240 

Top - 8400 

_ExtentX = 847 

__ExtentY = 847 

^Version = 327 680 

End 

Begin TabDlg.SSTab SSTabl 



CommonDialogl 



Height 
Left 

Tablndex 
Top 
Width 
_ExtentX 
_ExtentY 
_Version 
TabOrientation 
Tabs 

Tabs Per Row 
TabHeight 
TabCaption(O) 
TabPicture (0) 
Tab(0) . ControlEnabled= 
Tab(0) . Control (0 
Tab{0) . Control (0 
Tab<0) . Control (1 
Tab{0) . Control (1 
Tab(0) .Control £2 
Tab(0) .Control (2 
Tab(0) .Control (3 
Tab(0) .Control {3 
Tab{0) .Control (4 
Tab(O) .Control (4 
Tab(0) .Control (5 
Tab(0) .Control (5 
Tab(0) .Control (6 
Tab ( 0 ) . Control ( 6 
Tab(0) .Control (7 
Tab{0) .Control (7 
Tab(0) .Control (8 
Tab(0) .Control (8 



8535 
120 
0 

120 
10110 
17833 
15055 
393216 
1 
1 

10 
520 

"Main" 

" f rm_graphics . 



frx" :0000 



-1 'True 



"Label2 n 




.Enabled= 0 


' False 


"Labell" 




.Enabled^ 0 


' False 


" spr_data n 




.Enabled= 0 


' False 


n lst_sort_col" 


. Enabled= 0 


' False 


= "lst_y__axis" 




. Enabled= 0 


'False 


- f, lst_x_axis" 




. Enabled= 0 


'False 


= n but_histos " 




. Enabled= 0 


'False 


= "But_done u 




. Enabled= 0 


' False 


= " bu t_make_p lo t n 


. Enabled= 0 


'False 
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.Control (9) = " chk_unit_line" 
.Control (9) .Enabled= 0 'False 
.Control (10) - "chk_abs_value" 
.Control (10) .Enabled= 0 'False 
.Control (11) = "chk_sort_col" 
.Control (11) .Enabled= 0 'False 
.Control (12)= "chk__plot_matrix" 
. Control ( 12 ) . Enabled^ 0 ' False 
.Control (13 ) = "chk_ind__y_plots " 
. Control ( 13 ) . Enabled= 0 ' False 
.Control (14) = "cbk_ind_sorted ^plots' 
.Control (14) .Enabled= 0 'False 
. Control ( 15 ) = "Graph ( 0 ) *' 
. Control ( 15 ) . Enabled= 0 ' False 
. Cont ro 1(16)= n Frame 1 " 
.Control (16) .Enabled^ 0 'False 
.ControlCount= 17 



Tab(0 
Tab{0 
Tab(0 
Tab{0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 
Tab{0 
Tab(0 
Tab(0 
Tab(0 
Tab(0 

Begin VB. Frame Framel 

Height = 615 

Left = 360 

Tablndex = 17 

Top = 6480 

Width = 3495 

Begin VB . OptionButton opt_smooth 
Caption = "Smooth" 

Enabled = 0 'False 

Height = 255 

Left = 2040 

Tablndex = 20 

Top = 2 40 

Width = 1095 

End 

Begin VB. OptionButton opt_line 
Caption = "Line" 

Enabled = 0 'False 

Height = 255 

Left = 1200 

Tablndex = 19 

Top = 240 

Width = 73 5 

End 

Begin VB.CheckBox chk_trend_line 
Caption = "Trend" 

Height = 255 

Left = 120 

Tablndex = 18 

Top = 240 

Width = 855 

End 

End 

Begin Graphs Lib. Graph Graph 
Height = 255 

Index = 0 

Left = 8400 

Tablndex = 16 

Top = 63 60 

visible = 0 'False 
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VJidth = 495 

_Version = 327680 

__ExtentX = 873 

_ExtentY = 450 

__StockProps = 96 

GraphStyle = 2 

GraphType = 9 
Lef tTitleStyle = 1 

RandomData = 0 

SymbolData = "13-13-7-13" 

SymbolSize = 10 

End 

Begin VB.CheckBox chk„ind_sorted_plots 

Caption = "Individual Sorted Plots" 

Height = 255 

Left = 7080 

Tablndex - 15 

Top = 5870 

Width = 2175 
End 

Begin VB.CheckBox chk_ind__y_plots 

Caption = "Individual Y Plots" 

Height = 255 

Left = 3720 

Tablndex = 14 

Top = 5870 

Width = 1815 
End 

Begin VB.CheckBox chk_plot_matrix 

Caption = "Plot matrix" 

Height = 255 

Left = 3960 

Tablndex = 13 

Top = 6720 

Width = 1095 

End 

Begin VB.CheckBox chk_sort_col 

Caption = "Use Sort Item" 

Height = 255 

Left = 7080 

Tablndex = 9 

Top = 3480 

Width = 1455 

End 

Begin VB.CheckBox chk_abs_value 

Caption = "Use Absolute Value" 

Height = 255 

Left = 3720 

Tablndex = 8 

Top = 6240 

Width = 1935 

End 

Begin VB.CheckBox chk_unit_J-ine 
Caption = "Unit Line" 

Height = 255 

Left = 600 

Tablndex = 7 
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Top = 6240 

Width = 1215 
End 

Begin VB .CoiranandButton but_make_plot 

Caption = "Make plot" 

Height = 615 

Left = 600 

Tablndex = 6 

Top = 7320 

Width = 1575 
End 

Begin VB .CommandButton But_done 

Caption = "Done" 

Height = 615 

Left = 4080 

Tablndex = 5 

Top = 7320 

Width = 1575 
End 

Begin VB . CommandButton but_histos 

Caption = "Make Histos" 

Height = 615 

Left = 7320 

Tablndex = 4 

Top = 7320 

Width = 1575 

End 

Begin VB.ListBox lst_x_axis 

Height = 2010 

Left = 480 

MultiSelect = 2 ' Extended 

Tablndex = 3 

Top = 372 0 

Width = 1935 
End 

Begin VB.ListBox lst_y_axis 

Height = 2010 

Left = 3720 

MultiSelect = 2 'Extended 

Tablndex = 2 

Top = 3720 

Width = 1935 
End 

Begin VB.ListBox lst_sort_col 

Enabled = 0 'False 

Height = 2010 

Left = 7080 

Tablndex = 1 

Top = 3720 

Width = 193 5 
End 

Begin FPSpread. vaSpread spr_data 

Height = 3 015 

Left = 240 

Tablndex = 10 

Top = 120 

Width = 9495 
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_Version 
_ExtentX 
_ExtentY 
__StockProps 



131077 
16748 
5318 
64 



BeginProperty Font { 0BE35203-8F91-11CE-9DE3-OOAA004BB851} 



0 

700 
0 
0 
0 



Name 
Size 
Charset 
Weight 
Underline 
Italic 

Strikethrough 
EndProperty 
SpreadDesigner 

End 

Begin VB. Label Labell 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB. Label Label2 
Caption - 
Height 
Left 

Tablndex = 
Top - 
Width 
End 

End 

Begin VB.Menu file 

Caption = "File" 

Begin VB.Menu Close 

Caption = "Close" 

End 

End 

Begin VB.Menu edit 

Caption = "Edit" 

Begin VB.Menu copy 

Caption = °&Copy" 

Shortcut = 

End 

End 

End 

Attribute VB_Name = " f rm_graphics n 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB__Exposed = False 
Option Explicit 



n MS Sans Serif" 
8.25 



False 
False 
False 



f rm_graphics . f rx" ; 00 1C 



"X axis' 
255 
480 
12 

3360 
1575 



"Y axis" 
255 
3720 
11 

3360 
1575 



Private Sub but_done„Click ( ) 
Unload f rra„graphics 
f rm_main . Show 
End Sub 
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Private Sub but_histos__Click{ ) 
Dim i As Integer 
With frm__histo.lst_histo 
. clear 

For i = 1 To ist_x_axis.ListCount 
.Addltem lst_x_axis . list (i - 1) 
Next i 
End With 
Me. Hide 

f rm_histo . Show 
End Sub 

Private Sub but_make_plot_Click ( ) 

Dim i As Integer, n_tabs As Integer, n_plots As Integer 
If lst_x__axis.ListIndex < 0 Then 

MsgBox "Please select one or more x variables" 

Exit Sub 
End If 

If lst_y_axis. Listlndex < 0 Then 

MsgBox "Please select one or more y variables" 

Exit Sub 
End If 

If chk_sort_col .value = 1 And lst_sort_col . List Index < 0 Then 

MsgBox "Please select a sort variable" 

Exit Sub 
End If 

' figure out how may x and y selected 

Dim n_x As Integer, n_y As Integer, xs(l To 20) As Integer, ys(l To 20) 
As Integer 

For i = 0 To lst_x_axis . List Count - 1 
If lst_x_axis, Selected (i) = True Then 
n_x = n_x + 1 
xs (n__x) = i 
End If 
Next i 

For i = 0 To lst_y_axis .ListCount - 1 
If lst__y_axis. Selected (i) = True Then 
n_y = n__y + 1 
ys(n_y) = i 
End If 
Next i 

n_tabs = SSTabl.Tabs 

n_plots = Graph. count - 1 ' index starts at 0, but we don't use 0 
' single x, single y, single plot 

If n_x = 1 And n_y = 1 And chk_j?lot_matrix. value = 0 And chk_sort_col = 
0 Then 

n__ tabs = n_tabs + 1 

n_plots - n__plots + 1 

SSTabl.Tabs = n_tabs 

SSTabl.Tab = n_tabs - 1 

SSTabl .TabCaption(n_tabs - 1) = lst_x_axis . list ( lst_x_axis . Listlndex) 
& "/" & Is t_y_axis. list (lst_y_axis. Listlndex) 
Load Graph (n_plots) 

make_xy lst_x_axis . Listlndex + 1, lst„y_axis . Listlndex + 1, 
Graph (n_plots) 
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End If 

' single x, several 

If n_x - 1 And n_y > 1 And chk_plot_matrix . value = 0 And chk__sort_col = 
0 Then 

' one plot, one x, many y 
make_multiy xs(l), ys, n_y 
End If 

If n_x > 1 And chk_plot_matrix. value = 0 And chk_sort_cbl = 0 Then 
make_multi_x xs, ys, n_x, n_y 
End If 

' plot matrix, one plot 

If chk_plot_matrix. value = 1 And chk_sort_col = 0 Then 

plot_matrix xs, ys, n_x, n_y 
End If 

' sorted, one x, one y 

If chk_sort__col = 1 And n_x = 1 And n_y = 1 Then 
make_sorted_xy xs{l) , ys(l) , Me . lst_sort_col . Listlndex 
End If 

End Sub 

Private Sub make_sorted_xy (X As Integer, y As Integer, sort__col As 
Integer) 

r NOTE THAT LISTINDICES START AT 0 

Dim n_subs As Integer, max_obs As Integer, this_point As Integer 
Dim this_sub As Integer, this_graph_point As Integer, this_tab As 
Integer 

Dim n_data As Integer, i As Integer, this_plot As Integer, this_id As 
Integer 

' first need to pass through data, and count max obs per subject 
n_subs - 1 

spr_data.col = sort_col + 1 
spr_data.row = 1 
this_sub = spr_data. value 
For i = 2 To spr„data .MaxRows 
spr_data.row = i 

If spr_data. value <> this_sub Then 
n_subs = n_subs + 1 
this_sub = spr_data. value 
End If 
Next i 
' add a tab 

SSTabl.Tabs = SSTabl.Tabs + 1 
this_tab = SSTabl.Tabs 
SSTabl.Tab = this_tab - 1 
this_plot = Graph. count - 1 
this__plot = this_plot + 1 
Load Graph <this_plot) 
With Graph (this_plot) 

.Visible = True 

.Enabled = True 

.Top = 400 

.Left = 400 

.width = 9200 

.height = 7400 
' how many data 
n_data = spr_data .MaxRows 
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.NumSets = n_subs 
.NumPoints = max_obs 
this_sub - 1 
this_graph_point = I 
While this_point < n_jiata 
spr_data.row = this_point 
spr_data.col = sort_col 
If spr_data.value <> this_id Then 
this_id - spr_data . value 
this_sub = this_sub + 1 
this_graph_point = 1 
Graph (this_plot) .ThisSet = this_sub 
Graph ( this_plot ) .ThisPoint = this graph_point 
spr_data.col = X 
.XPos(i) = Val(spr_data.text) 
spr_data . col = y 
.Data(i) = Val (spr_data. text) 
End If 

Wend ' this point < n_data 
' loop over data sets and set options 
.SymbolData = 13 ' solid cirle 
. SymbolSize - 3 0 
spr_data.col = y 
spr_data.row = 0 

.Left/Title = spr_data. text 
spr_data.col = X 
.BottomTitle = spr_data . text 
.DrawMode - graphDraw 
End With 
End Sub 

Private Sub make_multi_x (xs ( ) As Integer, ys ( ) As Integer, n__x As 
Integer, n__y As Integer) 

' unique plot for each x, each plot will have all y's 

Dim this_plot As Integer 

For this_plot = 1 To n_x 

make__multiy xs { this _jplot ) , ys, n_y 

Next this_plot 

End Sub 

Private Sub plot_matrix (xs ( ) As Integer, ys() As Integer, n_x As 
Integer, n_y As Integer) 

Dim n_^plots As Integer 

Dim i As Integer, n As Integer, this_plot As Integer, p As Integer 
Dim n_data As Integer 

Dim this_tab As Integer, start__plot As Integer, end_plot As Integer 
this_tab = SSTabl.Tabs 

start__plot = Graph. count - 1 ' keep to specify this plot we're doing 
this_plot = start__plot ' current plot # 
Const left_margin = 50 
Const top_margin - 50 
Const gap = 0 

Dim width As Integer, height As Integer 

Dim max_dim As Integer ' maximum value of row or cols 

max dim = n_x 
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If n_y > n_x Then max_dim = n_y 

width = (SSTabl .width - lef t_margin * 2) / max_dim - (max_dim - 1) * 
gap 

' 400 FOR TAB ROW 

' need to adjust height for # of rows of tabs 

height = ( SSTabl .height - top_margin * 2 - 400) / max„dim - (max_dim - 
1) * gap 

n_plots = n_x * n_y + start_plot 

n_data = spr_data . MaxRows 
While this_plot < njdots 

this_tab = this_tab 4- 1 

SSTabl. Tabs = this_tab 

SSTabl. Tab = this_tab - 1 

SSTabl. TabCaption<this_tab - 1) = "Matrix" 
For i = 1 To n„x 

If this_plot = n_plots Then Exit For 
For n = 1 To n __y 

If this_plot = n__plots Then Exit For 
this_plot = this_plot +- 1 
Load Graph (this__plot) 
With Graph ( this jlot) 
.Visible = True 
. Borders tyle = 0 
.Left = left_margin + (n - 1) * width 
.width = width 

.Top = top_margin + (i - 1) * height 
.height = height 

.BottomTitle = lst_x_axis . list (xs (i) ) 
.LeftTitle = lst_y_axis . list {ys (n) ) 
.Enabled = True 
.NumSets = 1 

.NumPoints = n_data 
For p = 1 To n_data 
DiiQ junk As String 
spr_data.row = p 
' spr_data . col = 0 

' junk = spr_data . text 

' spr_data.col = 1 

' junk = spr„data. text 

spr_data.col = xs(i) +1 

.XPos(p) - Val <spr_data . text) 
spr_ data. col = ys (n) + 1 

.Data(p) = Val ( spr_data . text ) 
Next p 

. SymbolData = 13 ' solid cirle 
. SymbolSize = 20 + 18 * max__dim 

If Me. chk_trend_line. value = 1 Then 
If opt„line. value = True Then .LineStats = 8 
If opt_smooth. value = True Then 
.CurveOrder = 2 
.LineStats = 16 
. PatternedLines = 1 
.PatternData = 1 
End If 
End If 

.DrawMode = graphDraw 
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End With 
Next n 
Next i 
Wend 

End Sub 

Private Sub make_multiy (X As Integer, ys ( ) As Integer, n_y As Integer) 

Dim i As Integer, n As Integer, p As Integer, this„tab 

Dim n_data As Integer, this_y As Integer, this_plot As Integer 

' add a tab 

SSTabl.Tabs = SSTabl.Tabs + 1 
this_tab = SSTabl.Tabs 
SSTabl.Tab = this_tab - 1 
n_data - spr_data . MaxRows 
this__plot = Graph. count - 1 
this_plot = this__plot + 1 
Load Graph <this„plot) 
With Graph ( this_plot) 
.Visible = True 
.Enabled = True 
.Top = 400 
.Left = 400 
.width = 9200 
.height = 7 400 
.NumSets = n_y 
.NumPoints = n_data 
For this_y = 1 To n_y 

.ThisSet = this„y 
For p = 1 To n_data 
spr„data . row = p 
spr_data.col = X + 1 
.XPos(p) = Val{spr„data.text) 
spr_data.col = ys{this__y) + 1 
.Data(p) = Val (spr„data. text) 
Next p 

. SymbolData = 13 ' solid cirle 
.SymbolSize = 38 

If Me. chk__trend_line. value = 1 Then 

If opt_line. value = True Then .LineStats = 8 
If op t_smooth. value = True Then 
.CurveOrder = 2 
.LineStats = 16 
.PatternedLines = 1 
.PatternData - 1 
End If 
End If 

spr_data.col = ys(this_y) + 1 
spr_data.row = 0 
Dim divider As String 
.LeftTitle = .LeftTitle & divider & spr_data . text 
divider = V" 

spr_data.col = X + 1 
Next this_y 

spr_data,col = X + 1 
spr_data . row = 0 
.BottomTitle = spr_data . text 
.DrawMode = graphDraw 
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End With 

SSTabl.TabCaption(this_tab - 1) = spr__data . text 
End Sub 

Private Sub make_xy(X As Integer, y As Integer, this_graph As Graph) 
Dim n_data As Integer, i As Integer 

Dim sumx As Double, sumxx As Double, sumy As Double, sumxy As Double, 
sumyy As Double 

'Dim maxx As Single, minx As Single 

Dim slope As Single, intercept As Single, xval As Single, yval As 
Single 

'SSTabl.TabCapt ion (SSTabl. Tabs - 1) = lst_x_axis . list (X) & "/" & 
lst_y_axis . list (Y) 
With this_graph 

.Visible = True 

.Enabled = True 

.Top = 400 

.Left = 400 

.width = 9200 

.height = 7400 
' how many data 
n_data = spr_data . MaxRows 

.NumSets = 1 

.NumPoints = n_data 
' maxx = -999999999 
' minx = 999999999 
For i = 1 To n_data 
spr_data . row = i 
spr_data.col = X 

xval = Val (spr_data. text} 

.XPos(i) = xval 

sumx = sumx + xval 

sumxx = sumxx + xval * xval 
' If xval > maxx Then maxx = xval 
' If xval < minx Then minx = xval 

spr_data.col = y 

yval = Val ( spr__data . text ) 

.Data (i) = yval 

sumy - sumy + yval 

sumyy = sumyy + yval * yval 

sumxy = sumxy + yval * xval 
Next i 

.SymbolData = 13 ' solid cirie 

.SymbolSize = 30 
spr_data.col = y 
spr_data.row = 0 

.LeftTitle = spr_data . text 
spr_ data. col = X 

.BottomTitle = spr_data . text 
' add trend line 

If Me. chk_trend_line. value = 1 Then 
If op t_line. value = True Then .LineStats = 8 
If op t_smooth. value = True Then 
.CurveOrder = 2 
.LineStats = 16 
. PatternedLines = 1 
.PatternData = 1 
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End If 
End If 

Dim rsquare As Double 
Dim denora As Double 

denom = Sqr{(n_data * sumxx - sumx * sumx) * (n_data * sumyy - suxay * 
sumy) ) 

If denom > 0.00000000001 Then 

rsquare = (n_data * sumxy - sumx * sumy) / denom 
Else 

rsquare = 1 
End If 

.BottomTitle = .BottomTitle & n R"2 = " & Format (rsquare, "0.000") 
.DrawMode = graphDraw 
End With 
End Sub 



Private Sub chk_sort_col_Click ( ) 
If chk_sort_col .value = 1 Then 
lst_sort_col. Enabled = True 
Else 

lst_jsort_col .Enabled = False 
End If 
End Sub 

Private Sub chk_trend_line_Click ( ) 
If chk_trend_line .value = 1 Then 
op t_line. Enabled = True 
opt_smooth. Enabled = True 
Else 

op t_line. Enabled = False 
opt_smooth. Enabled = False 
End If 
End Sub 

Private Sub copy_Click<) 
MsgBox "Nothing to copy" 
End Sub 
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File fmjiisto.frm 

VERSION 5,00 

Object = "{BDC217C8-ED16-llCD-956C-000OCO4E4C0A}#l.l#O"; "TABCTL32 .OCX" 

Object = '■{827E9F53-96A4-11CF-823E-000021570103}#1.0#0 ,, ; n GRAPHS 3 2 . OCX " 
Begin VB.Form frm_histo 



Caption = 


"Make Histograms" 


ClientHeight = 


9 04b 


ClientLeft = 


60 


ClientTop 


630 


ClientWidth 


12120 


LinkTopic = 


" Forml " 


ScaleHeight = 


9045 


ScaleWidth 


12120 


StartUpPosition = 


3 'Windows Default 


Begin VB.TextBox 


txt_nbins 


Height 


285 


Left 


1320 


Tablndex 


14 


Text 


"10" 


Top 


6480 


Width 


855 


End 





Begin VB.CheckBox chk__autobins 

Caption = "Auto select bins" 

Height = 3 75 

Left = 480 

Tablndex = 12 

Top = 5880 

Width = 1695 

End 

Begin VB. Frame Frame4 

Height = 1095 

Left = 360 

Tablndex - 9 

Top = 4560 

Width = 1695 
Begin VB . OptionButton opt_lin 

Caption = "Linear scale" 

Height = 255 

Left = 240 

Tablndex = 11 

Top = 240 

Value = -1 'True 

Width = 1215 
End 

Begin VB .OptionButton opt_log 

Caption = "log scale" 

Height = 255 

Left = 240 

Tablndex = 10 

Top = 600 

Width = 1095 
End 

End 

Begin VB.TextBox txt_n_rows 

Height = 405 
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Left = 1680 

Tablndex = 8 

Text = "l n 

Top = 3840 

Width = 495 

End 

Begin VB. Frame Frame3 

Height = 1095 

Left = 360 

Tablndex - 5 

Top = 3240 

Width = 193 5 

Begin VB .OptionButton opt_matrix 

Caption = "Matrix" 

Height = 195 

Left = 240 

Tablndex = 7 

Top = 600 

Width = 1575 

End 

Begin VB .OptionButton opt_ind_plots 

Caption = "Individual plots" 

Height = 195 

Left = 240 

Tablndex = 6 

Top = 240 

Value = -1 'True 

Width = 1575 

End 

End 

Begin VB.ListBox lst_histo 

Height = 259 5 

Left = 480 

Tablndex - 4 

Top = 3 60 

Width = 133 5 

End 

Begin VB . CommandButton but_done 

Caption = "Done" 

Height = 615 

Left = 720 

Tablndex = 2 

Top = 7800 

Width = 1215 

End 

Begin VB .CommandButton but__make_plot 

Caption = "Make His to" 

Height = 615 

Left = 720 

Tablndex = 1 

Top = 6960 

Width = 1215 

End 

Begin TabDlg.SSTab tab_ his to 
Height = 8775 

Left = 2520 

Tablndex = 0 
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Top = 0 

Width = 9495 

_ExtentX = 16748 

_ExtentY = 15478 

.Version = 327681 

TabOr i ent a t i on = 1 
Tabs = 1 

TabsPerRow = 5 

TabHeight = 520 

TabPicture(O) = " f rm_histo. f rx" :0000 

Tab(0) .ControlEnabled= -1 'True 

Tab ( 0 ) . Control ( 0 ) = "Graph { 0 ) " 

Tab{0) .Control (0) .Enabled^ 0 'False 

Tab(O) .ControlCount= 1 

Begin GraphsLib .Graph Graph 

Height = 37 5 

Index - 0 

Left = 480 

Tablndex = 3 

Top = 480 

Visible = 0 'False 

Width = 615 

.Version = 327680 

_ExtentX = 1085 

_ExtentY = 661 

_StockProps = 96 

BorderStyle = 1 

GraphType = 3 

RandomData = 0 

End 

End 

Begin VB. Label Label2 

Caption = "n bins" 

Height = 255 

Left = 480 

Tablndex = 13 

Top = 6480 

Width = 735 

End 

Begin VB.Menu file 

Caption = "File" 

Begin VB.Menu exit 

Caption = "Exit" 

End 

End 

Begin VB.Menu edit 

Caption = "Edit" 

Begin VB.Menu copy 

Caption = ,! &Copy" 

Shortcut = "C 

End 

End 

End 

Attribute VB_Name = " f rm_histo° 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = False 
Attribute VB Predeolaredld = True 
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Attribute VB_Exposed = False 
Private cur__plot As Integer 
Private Sub but_make_plot_Click ( ) 

Dim i As Integer, n__tabs As Integer, n_j?lots As Integer 
If lst_histo.ListIndex < 0 Then 

MsgBox "Please select one or more x variables" 

Exit Sub 
End If 

' figure out how may x and y selected 

Dim n_x As Integer, xs(l To 20) As Integer 

For i = 0 To lst_histo . ListCount - 1 
If lst_histo. Selected(i) = True Then 
n__x = n__x + 1 
xs(n_x) = i 
End If 
Next i 

n_tabs ~ tab_histo .Tabs 

' only add a tab if this is not the first 

n_plots = Graph. Count - 1 ' index starts at 0, but we don't use 0 

If n__plots = 0 Then n_tabs = 0 
If n_x - 1 Then 

n__tabs = n_tabs + 1 
n_plots = n_plots + 1 
tab_.histo.Tabs = n_tabs 
tab__histo.Tab = n_tabs - 1 

tab_histo.TabCaption{n_tabs - 1) = lst_histo . list ( lst_histo . Listlndex) 
Load Graph (n_plots) 
With Graph (n__plots ) 

.Visible = True 

.Enabled = True 

.Top = 400 

.Left = 400 

.width = 9200 

.height = 7400 
' how many data 

n_da ta = f rm_graphics . spr_data . MaxRows 
.NumSets - 1 
.NumPoints = n_data 
make„histo lst_his to • Listlndex + 1, Graph (n__plots) 

End With 
End If 

End Sub 

Sub make_histo (X As Integer, this_graph As Graph) 
End Sub 

Private Sub chk_autobins_Click{ ) 
If chk_autobins. value = 0 Then 
txt_nbins .Enabled = True 
Else 

txt_nbins .Enabled = False 
End If 
End Sub 
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Private Sub copy_Click() 

If cur_plot = 0 Then 

MsgBox "Please select a plot" 

Else 

Graph (cur_plot) .DrawMode = graphCopy 
End If 
End Sub 

Private Sub exit_Click() 
f rm_graphics . Show 
Me. Hide 
End Sub 

Private Sub Form. Terminate ( ) 
f rm_graphics . Show 
End Sub 

Private Sub Graph_Click ( Index As Integer) 
cur_plot = Index 
End Sub 
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File frm_intermediate_results.fnn 



VERSION 5.00 

Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; 
Object = " {02B5E320-7292-llCF-93D5-0020AF99504A}#1.0#0" ; 
Object = " {BDC217C8-ED16-11CD-956C-OOOOC04E4COA}#1.1#0"; 
Object = " {6B7E6392-850A-101B-AFCO-4210102A8DA7}#1 .2#0" ; 
Begin VB.Form f rm_inter__results 



"SS32X25.0CX" 
"MSCHART.OCX" 
" TABCTL3 2 . OCX " 
" COMCTL3 2 . OCX " 



Caption 
ClientHeight 
ClientLef t 
Client Top 
ClientWidth 
LinkTopic 
ScaleHeight 
ScaleWidth 



" Intermediate 

7290 

3015 

4380 

12600 

" Forml" 

7290 

12600 



results' 



Begin Comet 1 Lib . Pr ogres sBar pgb_ind 



Height 
Left 

Tab Index 

Top 

Width 

_ExtentX 

_ExtentY 

__Version 

Appearance 



210 
2280 

4 

6480 
5175 
9128 
370 

327682 
1 



End 

Begin TabDlg.SSTab SSTabl 



Height 




6255 


Left 




120 


Tablndex 




1 


Top 




120 


Width 




12255 


_ExtentX 




21616 


_ExtentY 




11033 


^Version 




393216 


TabOrientation 




3 


Tabs 




2 


TabsPerRow 




2 


TabHeight 




520 


BeginProperty 


Font 


{0BE352 



-11CE-9DE3-00AA0O4BB851} 



Name 

Size 

Charset 

Weight 

Underline 

Italic 

Strike through 
EndProperty 
TabCaption(O) 
TabPicture(O) 
Tab{0) 
Tab(0) 



"Arial 

11.25 

0 

400 
0 
0 
0 



False 
False 
False 



"Intermediate results" 

" frm_intermediate_results . f rx" 



:0000 



ControlEnabled= -1 ' True 
Control (0}= "MSChartl" 



1 False 



Tab(0) .Control (0) .Enabled= 0 
Tab{0) .ControlCount= 1 
TabCaption(l) = "Final Results" 

TabPicture(l) = " f rm_intermediate_results . f rx" :001C 
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Tab(l) ,ControlEnabled= 0 'False 
Tab ( 1 ) . Control ( 0 ) = * spr_result " 
Tab { 1 ) . ControlCount= 1 
Begin MSChartLib.MSChart MSChartl 

Height = 5655 

Left = 1200 

OleObjectBlob = " f rm_intermedi at e_re suits . f rx" : 0038 
Tablndex = 2 

Top = 120 

Width = 103 3 5 

End 

Begin FPSpread. vaSpread spr_result 
Height = 5895 

Left = -74880 

Tablndex = 3 

Top = 120 

Width = 11520 

.Version = 131077 

_ExtentX = 2 0320 

„ExtentY = 10398 

_StockProps = 64 

BeginProperty Font {0BE3 5203-8F91-11CE-9DE3-OOAA004BB851 } 

Name = "MS Sans Serif" 

Size = 8.25 

Charset = 0 

Weight = 700 

Underline = 0 ' False 

Italic = 0 'False 

Strikethrough = 0 'False 
EndProperty 
MaxCols = 14 

ScrollBars = 2 

ScrollBarShowMax= 0 'False 

SpreadDe signer = " f rm_intermediate_results . f rx" : 2 0C4 
UserResize = 2 

VisibleCols = 500 

VisibleRows - 500 

End 

End 

Begin VB . CornmandButton but_stop__run 

Caption = "Stop Run" 

Height = 375 

Left = 9840 

Tablndex - 0 

Top = 6600 

Width = 855 

End 

Begin ComctlLib . ProgressBar pgb_gen 



Height 




210 


Left 




2280 


Tablndex 




5 


Top 




6840 


Width 




5175 


_ExtentX 




9128 


_ExtentY 




370 


_Version 




327682 


Appearance 




1 
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End 



Begin VB. Label Label2 
Caption = 
Height 
Left 

Tab Index = 

Top 

Width 



255 
840 
7 



6840 
1095 



"Generations 



n 



End 



Begin VB. Label Labell 
Caption = 
Height 
Left 

Tablndex = 

Top 

Width 



6480 
975 



255 
840 
6 



" Individuals 



End 

End 

Attribute VBJtfame = " f rm__inter_results " 
Attribute VB_Global Name Space = False 
Attribute VB__Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 

Private Sub but_stop_run_Click ( ) 
stop_run = True 
End Sub 

Private Sub spr_result_Click(ByVal Col As Long, ByVal Row As Long) 

If Col > 4 And Col < 13 Then MsgBox "col = " & Col & " row = " & Row 

End Sub 
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File frm_new_£roup.frm 

VERSION 5.00 

Begin VB.Form f rm_new_.gr oup 



Caption = 
ClientHeight 
ClientLeft 
Client Top 
ClientWidth 
LinkTopic : 
ScaleHeight 
ScaleWidth 
Begin VB.TextBox 

Height 

Left 

Tab Index = 
Top 
Width 
End 

Begin VB.TextBox txt_n_ 
Height 
Left 

Tablndex 
Text 

Top = 
Width 
End 

Begin VB .CommandButton 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB . CommandButton 
Caption = 
Height 
Left 

Tablndex = 
Top - 
Width = 
End 

Begin VB . Label Label2 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Labell 
Caption - 
Height 
Left 

Tablndex = 
Top 



"New Token Group" 
3195 
5220 
3735 
4680 
" Forml 11 
3195 
4680 
txt_stera 
375 



1440 
4 

720 
1455 

tokens 
375 
1440 
2 

ii ^ " 

1200 
1455 

but_cancel 

"Cancel" 

495 

2400 

1 

2400 
1335 

but__done 

"Done " 

495 

720 

0 

2400 
1335 



"Stem 
375 
240 
5 

720 
975 



"# of Tokens" 

375 

240 

3 

1200 
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Width = 975 

End 

End 

Attribute VB_Name = " f rm_new_group" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_JExposed = False 

Private Sub but_cancel_Click { } 
Me . txt„_n„tokens = -999 
Me. txt_stem = -999 
Me. Hide 

f rm„tokens . Show 
End Sub 

Private Sub but_done_Click < ) 
Me. Hide 

f rm__ tokens , Show 
End Sub 
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File frm_options,frm 



VERSION 5.00 

Begin VB.Form frm_options 



Caption 
ClientHeight 
ClientLef t 
Client Top 
ClientWidth 
LinkTopic 
ScaleHeight 
ScaleWidth 



" For ml " 

7485 

5265 

3360 

8625 

"Forml" 

7485 

8625 



Begin VB^CheckBox chk_save_best 



Caption = 

Height 

Left 

Tab Index = 
Top 

Value = 
Width 
End 

Begin VB. Frame Frame2 
Caption = 
Height 
Left 

Tab Index = 
Top = 
Width 



"Save best?" 

255 

4800 

43 

3960 

1 ' Checked 
3135 



"Random seed" 

1455 

4680 

38 

4440 
3495 



Begin VB.TextBox txt_rnd_seed 



Enabled 

Height 

Left 

Tab Index 
Text 
Top 
Width 



0 

375 

2040 

42 

"1" 

840 

615 



False 



End 

Begin VB . OptionButton opt_rnd_user 



Caption 

Height 

Left 

Tab Index 

Top 

Width 



"User Defined" 

255 

240 

41 

960 

1335 



End 

Begin VB . OptionButton opt_rnd_de fault 



Caption 

Height 

Left 

Tab Index 
Top 
Value 
Width 



"Use Default" 

255 

240 

40 

240 

-1 'True 
1335 



End 

Begin VB . OptionButton opt_rnd_clock 
Caption = "Use Clock 1 ' 

Height = 255 
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Left = 240 

Tablndex = 39 

Top = 600 

Width = 1335 

End 

End 

Begin VB.CheckBox chk_non_diag_omega 

Caption = "Include ga for non diagonal OMEGA" 

Height = 375 

Left = 4800 

Tablndex = 3 7 

Top = 3480 

Value = 1 'Checked 

Width = 2895 
End 

Begin VB.TextBox txt_f rame_shif t_prob 

Height = 285 

Left = 2760 

Tablndex = 35 

Text = "0.01" 

Top = 1320 

Width = 1455 
End 

Begin VB.CheckBox chk_save_output 

Caption = "Save output file" 

Height = 375 

Left = 4800 

Tablndex = 34 

Top = 3000 

Value = 1 'Checked 

Width = 2775 
End 

Begin VB.CheckBox chk_save_control 

Caption = "Save control file" 

Height = 375 

Left = 4800 

Tablndex = 33 

Top = 2 640 

Value = 1 'Checked 

Width = 277 5 
End 

Begin VB.TextBox txt_generations 

Height = 2 85 

Left = 2760 

Tablndex = 31 

Text = "20 M 

Top = 6120 

Width = 1455 
End 

Begin VB.TextBox txt_succ_crit 

Height = 285 

Left = 2760 

Tablndex = 29 

Text = "0.3" 

Top = 5160 

Width = 1455 

End 
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Begin VB.TextBox txt_corr_crit 

Height = 285 

Left = 2760 

Tablndex = 27 

Text = "50" 

Top = 3720 

Width = 1455 
End 

Begin VB.TextBox txt_lower_limit 

Height = 285 

Left = 2760 

Tablndex = 24 

Text = "0.3" 

Top = 4680 

Width = 1455 

End 

Begin VB.TextBox txt_upper_limit 

Height = 285 

Left = 2760 

Tablndex = 23 

Text = " 2 " 

Top = 4200 

Width = 1455 
End 

Begin VB.TextBox txt_cov__crit 

Height = 285 

Left = 2760 

Tablndex = 21 

Text = "1000" 

Top = 3240 

Width = 1455 
End 

Begin VB. Frame Framel 

Caption = "NONMEM call" 

Height = 1095 

Left = 4440 

Tablndex = 18 

Top = 3 60 

Width = 2535 

Begin VB . OptionButton opt_dll 

Caption = "DLL (NT only) - 

Height = 2 55 

Left - 120 

Tablndex = 20 

Top = 240 

Width = 1455 

End 

Begin VB .OptionButton opt_exe 

Caption = "EXE (NT or 9?)" 

Height = 255 

Left = 120 

Tablndex = 19 

Top = 600 



Value = -1 'True 

Width = 1935 



End 

End 
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Begin VB.TextBox txt_pop_size 

Height = 285 

Left = 2760 

Tablndex = 16 

Text = "50" 

Top = 5640 

Width = 1455 

End 

Begin VB . OptionButton opt_2runs 

Caption = "2" 

Height = 375 

Left = 6720 

Tablndex = 14 

Top = 1920 

Width = 855 

End 

Begin VB . OptionButton opt_4runs 

Caption = "4" 

Height = 375 

Left = 6720 

Tablndex = 13 

Top = 2280 

Value = -1 'True 

Width = 855 

End 

Begin VB . OptionButton opt_lrun 

Caption = "1" 

Height = 375 

Left = 6720 

Tablndex = 12 

Top = 1560 

Width = 855 

End 

Begin VB.TextBox txt_sigma__ crit 

Height = 2 85 

Left = 2760 

Tablndex = 10 

Text = "7.84" 

Top = 2760 

Width = 1455 

End 

Begin VB.TextBox txt_theta_crit 

Height = 2 85 

Left = 2760 

Tablndex = 7 

Text = "7.84" 

Top = 1800 

Width = 1455 

End 

Begin VB.TextBox txt__omega_crit 

Height = 285 

Left = 2760 

Tablndex = 6 

Text = "7.84" 

Top = 2280 

Width = 1455 

End 
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Begin VB.TextBox txt_cross_over_f req 



Height 
Left 

Tablndex 
Text 
Top 
Width 



235 

2760 

4 

"0.8" 

360 

1455 



End 

Begin VB.TextBox txt_mutation_rate 



Height 
Left 

Tablndex 
Text 
Top 
Width 



285 

2760 

2 

"0.001" 

840 

1455 



End 

Begin VB . CommandButton but_cancel 



Caption 

Height 

Left 

Tablndex 

Top 

Width 



"Cancel" 
495 
4680 
1 

6720 
1095 



End 

Begin VB . CommandButton but__done 
Caption = 
Height = 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB. Label Label8 
Caption - 
Height = 
Left 

Tablndex = 
Top 
* Width 
End 

Begin VB. Label Labell4 
Caption = 
Height 
Left 

Tablndex = 
Top - 
Width 
End 

Begin VB. Label Label 13 
Caption = 
Height 
Left 

Tablndex - 
Top 
Width 
End 

Begin VB. Label Labell2 



"Done" 
495 
2280 
0 

6720 
1095 



"Frame Shift Probability" 
255 
240 
36 

1320 
1695 



"Generation limit" 
255 
240 
32 

6120 
1455 



"Success Criteria" 
255 
240 
30 

5160 
2055 
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Caption = 

Height 

Left 

Tablndex = 
Top = 
Width 
End 

Begin VB . Label Labelll 
Caption = 
Height 
Left 

Tablndex = 

Top 

Width 

End 

Begin VB. Label LabellO 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Label9 
Caption = 
Height 
Left 

Tablndex = 
Top - 
Width 

End 

Begin VB. Label Label7 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB. Label Label6 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB. Label Labels 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Label 4 
Cacti on - 



"Penalty for corr > 0.95" 

255 

240 

28 

3720 
2055 



"Lower limit of scaled fitness" 

255 

240 

26 

4680 
2055 



"Upper limit of scaled fitness' 

255 

240 

25 

4200 
2295 



"Covariance criteria" 

255 

240 

22 

3240 
1335 



"Population size" 

255 

240 

17 

5640 
1095 



"Number of threads" 

255 

4920 

15 

1800 
1695 



"Sigma criteria' 1 

255 

240 

11 

2760 
1335 



"Omega criteria" 
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Height = 
Left 

Tablndex 
Top 
Width 
End 

Begin VB. Label Label3 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB. Label Label2 
Caption = 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Labell 
Caption 
Height 
Left 

Tablndex = 
Top 
Width 
End 



Criteria" 



255 
240 
9 

2280 
1335 



" Theta 
255 
240 
8 

1800 
1695 



"Cross over Frequency" 

255 

240 

5 

240 
1695 



"Mutation rate" 

255 

240 

3 

840 
975 



End 

Attribute VB„Name = " f rm_options " 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 



Private Sub but__cancel_Click { ) 

Me . Hide 

f rm_main . Show 

End Sub 



Private Sub but_done__Click ( ) 
mutation_rate = Me . txt_mutation_rate 
cross_over_freq - Me . txt_cross_pver_f req 
f rame_shif t_prob = Me . txt_f rame_shif t_prob 
theta_crit = Me. txt__theta_crit 
omega_crit = Me . txt„omega_crit 
sigma_crit - Me. txt_sigma_crit 
cov_crit = Me. txt_cov_crit 
success_crit = Me, txt_succ_crit 
genera tion_limit = Me. txt_generations 
lower_f itness_limit = Me . txt_lower_limit 
upper_f itness_limit = Me . txt„upper__l imi t 
seed_value = Me . txt_rnd_seed . text 

If Me. opt_rnd_clock = True Then seecLtype = "clock" 

If Me.opt_rnd_default = True Then seed_type = "default" 
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If Me.opt_rnd_user = True Then seed_type = "user" 

corr_crit = Me . txt_corr_crit 

If opt_dll = True Then call_method = "dll" 

If opt_exe = True Then call_method = "exe" 

If chk_save__control - 1 Then 

save_control = True 

Else 

save_control = False 
End If 

If chk_save_best = 1 Then 

save_best = True 

Else 

save_best = False 
End If 

If chk_save_output = 1 Then 

save_output = True 

Else 

save_output = False 
End If 

pop_size = Me . txt_pop_size 
If pop_size- Mod 2 <> 0 Then 

MsgBox "Population size must be even number " 
Me.txt_pop__size.SelStart = 0 

Me. txt_pop_size . SelLength = Len (Me . txt _pop_size) 
Me . txt_pop_size . SetFocus 
Exit Sub 
End If 

' need to redimension genome for non diagonal omega 

Dim g2dim As Integer 

If Me.chk_non_diag_omega = 1 Then 

omega„block = True 

Else 

omega_block = False 

End If 
Me . Hide 
f rm_ma i n . S how 
End Sub 

Private Sub chk_non_diag_omega_Click ( ) 
If chk_non_diag_omega = True Then 
omega_block = True 
Else 

omega_block = False 
End If 
End Sub 

Private Sub Form_Load ( ) 

set_options 

End Sub 

Private Sub opt_both_limit_Click { ) 
txt_time . Enabled = True 
txt_generations . Enabled = True 
End Sub 

Private Sub opt_generations__Click{ ) 

txt_time. Enabled = False 
txt_generations . Enabled = True 
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End Sub 

Private Sub opt_time_Click( ) 

txt_time. Enabled = True 
txt_genera t ions . Enabled = False 
End Sub 



Private Sub opt_rnd_clock_Click ( ) 
seed_type = "clock" 
Me. txt_rnd_seed. Enabled = False 
End Sub 

Private Sub opt__rnd_def ault_Click ( ) 
seed_type = "default" 
Me . txt_rnd_seed. Enabled = False 
End Sub 

Private Sub opt_rnd_user_Click ( ) 

s eed_type = "user" 

Me . txt__rnd„seed . Enabled = True 

End Sub 

Private Sub txt_rnd__seed_lostf ocus ( ) 
On Error GoTo number ror 
seed_value ~ Me. txt_rnd_.se ed 

Exit Sub 
aum_error : 

MsgBox ("Please enter a number") 

Me . txt_rnd_seed . Set Focus 

Me . txt_rnd_seed . Se IS tart = 0 

Me . txt__rnd_seed . Sel Length = Len (Me . txt_rnd_seed . text ) 

On Error Resume Next 
End Sub 
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Filefrm results.frm 



VERSION 5.00 

Object = " {B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5* 
Begin VB.Form frm_results 



l SS32X25.0CX t 



Caption = 


"Results" 


ClientHeight 


8490 


ClientLef t 


60 


ClientTop = 


345 


ClientWidth 


13245 


LinkTopic = 


" Forml" 


ScaleHeight = 


8490 


ScaleWidth 


13245 


StartUpPosition = 


3 'Windows Default 


Begin FPSpread. vaSpread spr_result 


Height 


6255 


Left 


360 


Tablndex = 


1 


Top 


480 


Width 


12480 


__Version = 


131077 


_ExtentX 


22013 


_ExtentY 


11033 


_StockProps : 


64 


BeginProperty Font {0BE35203-8F91-11CE- 


Name 


"MS Sans Serif" 


Size 


8.25 


Char set 


0 


Weight 


700 


Underline 


0 'False 


Italic 


0 'False 


Strike through 


0 'False 


EndProperty 




MaxCols : 


12 


ScrollBars - 


2 



ScrollBarShowMax= 
SpreadDesigner = 
UserResize = 
VisibleCols = 
VisibleRows - 



0 'False 

" f rm_results . frx n : 0000 
2 

500 
500 



End 

Begin VB . CommandButton but_done 



Caption 

Height 

Left 

Tablndex 

Top 

Width 

End 

End 

Attribute VB_Wame 



" Done " 
615 
6120 
0 

7680 
1095 



= " frm_results" 



Attribute VB_GlobalName Space = False 
Attribute VB__ Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
Private Sub but_done_Click ( ) 
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Me. Hide 
End Sub 

Private Sub spr_result_Click {ByVal Col As Long, ByVal Row As Long) 
If Col > 4 Then MsgBox "col = " & Col & " row = " & Row 
End Sub 
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Filefrra sort results.frm 



VERSION 5,00 

Begin VB.Form f rm_sort_re suits 



Caption 

ClientHeight 

ClientLef t 

ClientTop 

ClientWidth 

LinkTopic 

ScaleHeight 

ScaleVJidth 

StartUpPosition 



"Sort Results" 

3975 

60 

345 

6930 

"Forml" 

3975 

6930 

3 'Windows Default 



Begin VB.CommandButton but_cancel 



Captxon 

Height 

Left 

Tablndex 

Top 

Width 



"Cancel* 
495 
3720 
7 

3240 
1095 



End 

Begin VB.CoromandButton but_Sort 



Caption 

Height 

Left 

Tablndex 

Top 

Width 



"Sort* 
495 
1920 
6 

3240 
1095 



End 

Begin VB.ListBox lst_third_sort 



Height 
ItemData 
Left 
List 

Tablndex 

Top 

Width 



1230 

"frm_sort_results. frx" :0000 
4800 

"frm_sort_results. frx" :0016 
4 

1320 
1335 



End 

Begin VB.ListBox lst_second_sort 



Height 
ItemData 
Left 
List 

Tablndex 

Top 

Width 



1230 

" f rm_sort_results . frx" : 004E 
2640 

,f frm_sort_results . frx" :00 64 
2 

1320 
1335 



End 

Begin VB.ListBox lst_f irst_sort 



Height = 

ItemData 

Left 

List = 
Tablndex = 
Top 

Width = 
End 

Begin VB. Label Label3 



1230 

" f rm_sort„results . frx" : 009C 
600 

" f rm_sort_results . frx" : O0B2 
0 

1320 
1335 
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Caption 

Height 

Left 

Tablndex 

Top 

Width 



"Third Sort Variable 



375 

4800 

5 



720 
1335 



End 



Begin VB. Label Label2 
Caption = 
Height 
Left 

Tablndex = 
Top = 
Width 



375 

2520 

3 



720 
1815 



"Second Sort Variable 



ir 



End 



Begin VB. Label Labell 
Caption = 
Height 
Left 

Tablndex - 
Top = 
Width 



375 
480 
1 



720 
1335 



"First Sort Variable" 



End 

End 

Attribute VB_Name = w f rm__sort_results " 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 

Private Sub but_cancel_Click ( ) 
Me . Hide 
Unload Me 

End Sub 

Private Sub but_Sort_Click ( ) 

Dim max_val As Single, max_dig As Integer, f format As String 

max_val = -99999999 

Me. Hide 

' setup_data 

With f rm_main. spr_result 

' if using columns 1 or 4, format the data 



If 


Me 


. lst_ 


.first. 


.sort . 


Listlndex 




0 


Or Me.lst_second„sort. 


.Listlndex = 


0 


Or 


Me 


. lst_ 


.third. 


.sort. 


List Index 




0 


Then col_format (1) 






If 


Me 


.1st. 


_f irst_ 


.sort . 


Listlndex 




3 


Or Me.lst_second_sort , 


.Listlndex - 


3 


Or 


Me 


.lst_ 


.third. 


.sort . 


Listlndex 




3 


Then col_format (4) 






If 


Me 


.lst_ 


_first_ 


.sort . 


Listlndex 




4 


Or Me.lst_second_sort 


.Listlndex = 


4 


Or 


Me 


.1st. 


.third. 


.sort . 


Listlndex 




4 


Then col_format (8) 






If 


Me 


.1st. 


.first. 


.sort. 


, Listlndex 




5 


Or Me.lst_second_sort 


.Listlndex = 


5 


Or 


Me 


.1st. 


.third. 


_sort , 


. Listlndex 




5 


Then col_format (9) 







Dim keyl As Integer, key2 As Integer, key3 As Integer 
If Me. 1st first sort . Listlndex = -1 Then 
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MsgBox ("Please select one or more sort keys") 
Exit Sub 
End If 

keyl = Me. Is t_first_sort. Listlndex + 1 

If keyl = 5 Then keyl = 8 

If keyl = 6 Then keyl = 9 

key2 = Me . Is t_second_sort .Listlndex + 1 

If key2 = 5 Then key2 = 8 

If key 2 - 6 Then key2 = 9 

key3 = Me . Is t_third__sort .Listlndex -t- 1 

If key 3 = 5 Then key 3 = 8 

If key 3 = 6 Then keyl = 9 

.col = 1 
.Col2 = 9 
.row = 1 

.Row2 = run__number 
.SortKey(l) = keyl 
. SortKeyOrder (1) = 1 
If key2 > 0 Then 
.SortKey(2) = key2 
.SortKeyOrder (2) = 1 
End If 

If key 3 > 0 Then 
.SortKey(3) = key3 
.SortKeyOrder (3) = 1 
End If 

' we need to format columns 1 and 4 

If keyl = 2 Or keyl = 3 Then . SortKeyOrder (1) = 2 

If key2 = 2 Or key2 = 3 Then . SortKeyOrder (2 ) = 2 

If key 3 = 2 Or key3 = 3 Then . SortKeyOrder (3 ) = 2 

.SortBy = 0 

.Action = 25 

If Me. Is t_first_sort .Listlndex = 0 Or Me . Is t_second_s or t . Listlndex 



Or Me . Is t_third_s or t .Listlndex = 
If Me . lst_first_sort .Listlndex = 

Or Me. lst_third_sort . Listlndex = 
If Me. lst__f irst_sort . Listlndex = 

Or Me. lst_third_sort. List Index = 
If Me . lst__f irst_sort . Listlndex = 



0 Then col_unformat (1) 

3 Or Me* Is t_second_sort . Listlndex 

3 Then col_unformat (4) 

4 Or Me. Is t_second_sort .Listlndex 

4 Then col__unf orrnat (8) 

5 Or Me. lst_second__sort . Listlndex 



Or Me. lst_third_sort. Listlndex = 5 Then col_unformat (9) 
End With 
Unload Me 
End Sub 

Sub col_format (coll As Integer) 

Dim this_row As Integer, max_val As Single, max_dig As Integer 
max_val = -99999999 
With frm_main.spr_result 

.col = coll 
For this_row = 1 To run_number 

.row = this_row 

If Val(.text) > max_val Then max„val = Val(.text) 
Next this_row 
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If max_val <> 0 Then 
max_dig = Log (max_val) / Log (10) 
Else 

MsgBox ("results cannot be sorted") 
Exit Sub 
End If 

fformat = String (max_dig + 1, "0" ) & " . " & String(8 - max_dig, "#") 

' and format all the data 

For this_row = 1 To runjnumber 

.row = this_row 

.text = Format (Val ( .text) , fformat) 
Next this_row 
End With 
End Sub 

Sub setup_data() 

Dim this_row As Integer 

With frm_main. spr_result 

f rm__main . SSTabl .Tab = 2 

For this_row = 1 To 40 

.row = this_row 

.col = 1 

.text = (Rnd() * 4) A 3 
.col = 2 

. text = this_row Mod 2 
.col = 3 

. text = this_row Mod 3 
.col = 4 

.text = (Rnd() * 4) * 3 
.col = 8 

.text = this_row - {this_row Mod 10) 
.col = 9 

.text = this_row Mod 10 
Next this_row 
End With 
End Sub 

Sub col__unformat (col As Integer) 
With fr;m_main. spr__result 
.col - col 

For this_row = 1 To run_number 
.row = this_row 
.text = Val ( . text) 
Nex t t h i s_r o w 
End With 
End Sub 
Sub new_sort() 

Dim max_val As Single, max_dig As Integer/ fformat As String 
max_val = -9999999 
Me . Hide 

With f rm_main. spr_result 
For this_row = 1 To 1000 
.col = 1 

.row = this_row 

.text = (Rnd() * 10) A 3 

If Val {.text) > max_val Then max_val = Val (.text) 
.col = 2 

.text = this_row Mod 2 
Next this_row 
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max_dig - Log (max_val) / Log (10) 

fformat = String (max_dig, "0") & " . " & StringdO - max_dig / "#") 

' and format all the data 

For this_row = 1 To 100 0 

.col = 1 

.row = this_row 

.text = Format (Val ( .text) , fformat) 
.col = 2 

.text = Format (Val (. text) , fformat) 
Next this_row 
.col = 1 
.Col2 = 2 
.row = 1 
.Row2 = 1000 
' read data into array 
.SortKey(l) = 2 
.SortKey(2) = 1 
.SortKeyOrder (1) = 2 
.SortKeyOrder (2) = 1 
.Action = 2 5 
' and put it back 

For this__row = 1 To 1000 

.col = 1 

. row = this_row 

.text = Val ( . text) 

.col = 2 

.text = Val (.text) 
Next this_row 
End With 
Unload Me 
End Sub 
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Filefrm text.frm 



VERSION 5.00 

Object = " {F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0 ,, ; "Comdlg32 . ocx" 
Begin VB.Form frm_text 



Caption 


"Forml" 


ClientHeight 


10830 


ClientLef t 


300 


ClientTop 


630 


ClientWidth 


15075 


LinkTopic 


"Forml" 


ScaleHeight 


10830 


ScaleWidth 


15075 


Begin MSComDlg 


.CommonDialog 1 



Left = 2520 

Top = 1680 

_ExtentX = 847 

_ExtentY = 847 

^Version = 327680 

End 

Begin VB.TextBox txt_text 

BeginProperty Font 

Name = "Courier" 

Size = 9.75 

Charset = 0 

Weight = 400 

Underline = 0 'False 

Italic = 0 'False 

Strikethrough = 0 'False 

EndProperty 

Height = 10815 

Left = 0 

Locked = -1 'True 

MultiLine = -1 ' True 

ScrollBars = 3 'Both 

Tablndex = 0 

Top = 0 

Width = 15000 

End 

Begin VB.Menu file 

Caption = "File" 

Begin VB.Menu copy 

Caption = "Copy" 

End 

Begin VB.Menu exit 

Caption = "Exit" 

End 

End 

Begin VB.Menu edit 

Caption = "Edit" 

Begin VB.Menu font 

Caption = "Font." 

End 

End 

End 

Attribute VB_Name = " frm_text" 
Attribute VB_GlobalNameSpace = False 
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Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VBJExposed = False 
Private Sub Commandl_Click ( ) 
Me. Hide 
frm_jxtain.Show 
End Sub 

Private Sub copy_Click() 
Dim copy_string As String 
If txt_text .SelStart = 0 Then 
MsgBox "No text selected" 
Exit Sub 
End If 

copy_string = Mid ( txt__text ; txt_text . SelStart , txt_t ex t . Sel Length) 
Clipboard. SetText copy„string ' Put text on Clipboard. 
End Sub 

Private Sub exit_Click{) 
Me. Hide 
frm_main. Show 
End Sub 

Private Sub font_Click() 

CommonDialogl . FontBold = txt_text . FontBold 
CornmonDialogl .Font Italic = txt_text . Fontltalic 
CoinmonDi al og 1 . F ontName = txt_t ex t . Fon t Name 
CommonDialogl .FontSize = txt_text . FontSize 
CommonDialogl .CancelError = True 
On Error GoTo ErrHandler 
' Set the Flags property 

CommonDialogl. Flags = cdlCFEffects Or cdlCFBoth 
' Display the Font dialog box 
CommonDialogl . ShowFont 

txt_text. Font .Name = CommonDialogl . Fon tName 
txt_text. Font .Size = CommonDialogl . FontSize 
txt_text . Font . Bold = CommonDialogl . FontBold 
txt__text .Font . Italic = CommonDialogl . Fontltalic 
txt_text. Font. Underline = CommonDialogl . Fon tUnder line 
txt_text . FontStrikethru = CommonDialogl . FontStr ikethru 
txt_text .ForeColor = CommonDialogl .Color 
Exit Sub 
ErrHandler : 

' User pressed the Cancel button 
Exit Sub 

'CommonDialogl .FontBold = txt__text . FontBold 
'CommonDialogl .Fontltalic = txt_text .Fontltalic 
'CommonDialogl .FontName = txt_text . FontName 
'CommonDialogl. Font Size = txt_text . FontSize 
' CommonDialogl . ShowFont 

' txt_text . FontName = CommonDialogl . FontName 
'txt_text. FontBold = CommonDialogl . FontBold 
'txt_text .Fontltalic = CommonDialogl .Fontltalic 
'txt_text. FontSize = CommonDialogl . FontSize 
End Sub 
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Private Sub Form_Terminate ( ) 

Me . Hide 

f rm__main . Show 

End Sub 

Private Sub Form_Unload (Cancel As Integer) 

Me. Hide 

f rm_main . Show 

End Sub 
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File frm_testirm 



VERSION 5.00 

Begin VB.Form frm__test 

Caption = 

ClientHeight = 

ClientLeft 

ClientTop = 

ClientWidth 

LinkTopic = 

ScaleHeight 

ScaleWidth 

StartUpPosition 



"test" 

5655 

60 

345 

6705 

" Forml " 

5655 

6705 

3 'Windows Default 



'True 



Begin VB .CommandButton Commandl 
Caption = "done" 

Height = 255 

Left = 1680 

Tablndex = 1 

Top = 5400 

Width = 975 

End 

Begin VB.TextBox Textl 
Height 
Left 

MultiLine = 
Tablndex 

Text = 
Top = 
Width 
End 

End 

Attribute VB_Name - M frm__test n 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB„PredeclaredId = True 
Attribute VB_Exposed = False 
Private Sub Commandl_Click ( ) 
Me. Hide 
'Unload Me 
End Sub 



4935 
480 
-1 
0 

"frm_test . f rx" :0000 
360 
6015 
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Filefrm tokens.frm 



VERSION 5.00 

Begin VB.Form frm__tokens 



Caption 


- " Tokens " 


ClientHeight 


6360 


ClientLef t 


1620 


ClientTop 


1890 


ClientWidth 


11910 


LinkTopic 


"Forml" 


ScaleHeight 


6360 


ScaleWidth 


11910 


Begin VB.ListBox lst_token_group 


Height 


3375 


Left 


9240 


Tablndex 


10 


Top 


960 


Width 


2175 


End 





Begin VB . CommandButton but_remove„group 

Caption = "Remove Token Group' 

Height = 495 

Left = 10200 

Tablndex = 9 

Top = 4680 

Width = 1575 
End 

Begin VB. CommandButton but_new_group 

Caption = "New Token Group" 

Height = 495 

Left = 8640 

Tablndex = 8 

Top = 4680 

Width = 1455 
End 

Begin VB. CommandButton but_new_set 

Caption = "New Token set" 

Height = 495 

Left = 4200 

Tablndex = 5 

Top = 4680 

Width t * 455 

End 

Begin VB . CommandButton but_remove_set 

Caption = "Remove Token set" 

Height = 495 

Left = 6240 

Tablndex = 3 

Top = 4680 

Width = 1575 
End 

Begin VB.ListBox lst_token_sets 

Height = 3375 

Left = 3240 

Tablndex = 2 

Top = 960 

Width = 5295 
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End 



Begin VB.ListBox lst_tokens 



Height 
Left 

Tablndex 

Top 

Width 



3375 

360 

1 

960 
2535 



End 



Begin VB . CommandButton but_done 



Caption 
Height = 
Left 

Tablndex = 
Top = 
Width 
End 

Begin VB. Label Label3 
Caption = 
BeginProperty Font 

Name 

Size 

Charset 

Weight 

Underline 

Italic 

Strikethrough 
EndProperty 
Height 

Left 

Tablndex = 
Top 
Width 
End 

Begin VB * Label Label2 
Caption = 
BeginProperty Font 
Name 
Size 
Charset 
Weight 
Underline 
Italic 

Strikethrough 
EndProperty 
Height 
Left 

Tablndex = 
Top 
Width 
End 

Begin VB. Label Labell 
Caption = 
BeginProperty Font 

Name 

Size 

Charset 

Weicrht 



" Done ' 
495 
4920 
0 

5760 
1695 



"Token Groups" 



"MS 

12 

0 

400 
0 
0 
0 



Sans Serif 1 



' False 
'False 
'False 



375 

8400 

11 

120 

1695 



"Token Sets" 

"MS Sans Serif 

12 

0 

400 
0 
0 
0 

375 
4800 
7 

120 
1335 



'False 
'False 
'False 



1 Tokens " 

"MS Sans Serif" 

12 

0 

400 
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Strikethrough = 0 
EndProperty 



Underline = 0 



Italic = 0 



' False 
'False 
'False 



Height = 375 

Left = 1080 

Tablndex = 6 



Top = 0 



Width = 133 5 



End 

Begin VB. Label lbl_token_name 



Height = 375 

Left = 4560 

Tablndex = 4 



Top = 480 

Width = 1935 



End 

End 

Attribute VB_Name = " f rm_tokens " 
Attribute VB_GlobalName Space = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Dim cur regroup As String 

Dim curr_position As Integer ' which token group 

Dim curr„token As Integer ' which token 

Dim curr_token_set As Integer ' which token set 

Private Sub but_done__Click ( ) 

Me. Hide , 

f rrr_main . Show 

End Sub 

Private Sub but_new_group_Click ( ) 
Me . Hide 

f rm„new_group . txt_n_tokens = " " 

f rm_new_.gr oup . txt„n_tokens = "1" 

f rm_new_gr oup , Show moda 1 : = 1 , owner form : -Me 

' n_tokens is set to -999 by cancel 

If frm_new_group.txt_n_tokens = »-999" And frm_new_gr oup . txt_s tern 
999" Then 
Exit Sub 
End If 

n„token_groups = n_token_groups + 1 • 
Dim curr_stem As String 
curr_stem = frm_new_group. txt_stem 
token_col lection (n_token_groups) . stem = curr_stem 
token_collection(n_token_groups) .n_tokens = f rm_new_group . txi 
lst_token„group . Addltem curr_stem 
Me. lbl_token_name = curr_stem 
curr_group = curr_stem 
currjposition = n_token„groups 
lst_token_group.ListIndex - curr_position - 1 
' token_collection(curr_position) .n_token_sets = 0 
token_collection (currjposition) . get_token_set lst_token_sets 
lst_tokens .clear 
End Sub 
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Private Sub but__new__set_Click ( ) 
If curr_position > 0 Then 

token_collection(curr__position) . add__token_set lst_t oken_.se ts 
curr_token_set = lst_token_sets . ListCount 

token_collection(curr_position) .get_tokens lst_tokens, curr_token_set 
lst_token_sets .Listlndex = lst_token_sets . ListCount - 1 
End If 
End Sub 

Private Sub but_remove_group_Click ( ) 
Dim this_group As Integer 
If lst_token_group. Listlndex > -1 Then 
n_token_groups = n__token_groups - 1 

For this_group = lst_token_group. Listlndex + 1 To n_groups - 1 
Set token_collection(this_group) = token_collection ( this_group + 1} 

Next this_group 

Set token_collection(n„groups) = Nothing 

lst_token_group . Removeltem ( lst_token_group . Listlndex) 

token_collection(curr ^position) .get_token_set lst_token_sets 

If Is t_token_group. ListCount > 0 Then 

lst„token_group . Listlndex = 0 

Else 

lst_token_group. Listlndex = -1 
lst_token_sets . clear 
End If 
curr_position = 1 

token_collection(curr_position) . get _token_.se t lst_token_sets 
If lst_token_sets. ListCount > 0 Then 
Is t_token_sets. Listlndex = 0 
Else 

Is t„token_sets .Listlndex = -1 

lst__tokens .clear 

End If 
End If 
End Sub 

Private Sub but_remove__set_Click () 
If lst_token_sets. Listlndex > -1 Then 
token„collection(curr position) . remove_token_set 
{ Is t_token_sets .Listlndex + 1) 

token_collection(curr_position) . get_token_set lst„token_sets 
curr_position = lst_token_group . Listlndex + 1 

token„collection(curr_position) . get_token_set lst_t oken_.se ts 
If Is t_token_sets .ListCount > 0 Then 
Is t_token_sets .Listlndex = 0 
Else 

lst_token_sets . Listlndex = -1 
lst__tokens . clear 
End If 

curr_token_set = Is t_token_sets . Listlndex + 1 

token_collection(curr_position) .get_tokens lst_tokens, curr_token_set 
End If 
End Sub 
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Private Sub Form_Load{) 
curr_position = 1 
curr_token_set = 1 
curr_token = 1 
End Sub 

Private Sub lst_token_group__Click( ) 

curr_group = Is t„t oken_group . list ( Is t_token_group . List Index) 
curr_position = lst_token_group . List Index + 1 
token_collection(curr„position) .get_token_set lst_token__sets 

curr_token_set = 1 

If lst_token_sets.ListCount > 0 Then 

Is t_token_sets. List Index = curr_token_set - 1 

End If 

token_collection(curr_position) .get_tokens lst„tokens, curr_token_set 
End Sub 

Private Sub lst_token_sets_Click( ) 
curr_token_set = lst_token_sets -Lis tlndex + 1 

token_collection(curr_position) .get_tokens lst„tokens, curr_token_set 
End Sub 

Private Sub lst__tokens_dblClick( ) 
curr_token = lst_tokens .List Index + 1 
f rm_edit_token . txt_token = 

token_collection(curr„position) . get__token„with_lines {curr__token_set , 

curr_token) 

Me. Hide 

frm„edit__token.Show modal :=1, ownerf orrri: =Me 
' first change the token in the token set 

token_collection(curr_position) .set_token curr_token„set , curr_token, 
f rm_edit_ token. txt__token 
' update the tokenn list 

token_collection(curr_position) .get_tokens lst_tokens, curr_token_set 
' update token set list 

token_collection(curr_position) . get_token_set lst_token_sets 
End Sub 



